|
428
|
1 /* Lisp parsing and input streams.
|
|
|
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
|
|
|
3 Copyright (C) 1995 Tinker Systems.
|
|
1261
|
4 Copyright (C) 1996, 2001, 2002, 2003 Ben Wing.
|
|
428
|
5
|
|
|
6 This file is part of XEmacs.
|
|
|
7
|
|
|
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
|
|
|
11 later version.
|
|
|
12
|
|
|
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
|
|
|
16 for more details.
|
|
|
17
|
|
|
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. */
|
|
|
22
|
|
|
23 /* Synched up with: Mule 2.0, FSF 19.30. */
|
|
|
24
|
|
|
25 /* This file has been Mule-ized. */
|
|
|
26
|
|
|
27 #include <config.h>
|
|
|
28 #include "lisp.h"
|
|
|
29
|
|
|
30 #include "buffer.h"
|
|
|
31 #include "bytecode.h"
|
|
|
32 #include "elhash.h"
|
|
1292
|
33 #include "file-coding.h"
|
|
428
|
34 #include "lstream.h"
|
|
|
35 #include "opaque.h"
|
|
1292
|
36 #include "profile.h"
|
|
3439
|
37 #include "charset.h" /* For Funicode_to_char. */
|
|
428
|
38
|
|
|
39 #include "sysfile.h"
|
|
|
40 #include "sysfloat.h"
|
|
771
|
41 #ifdef WIN32_NATIVE
|
|
|
42 #include "syswindows.h"
|
|
|
43 #endif
|
|
428
|
44
|
|
|
45 Lisp_Object Qread_char, Qstandard_input;
|
|
|
46 Lisp_Object Qvariable_documentation;
|
|
|
47 #define LISP_BACKQUOTES
|
|
|
48 #ifdef LISP_BACKQUOTES
|
|
|
49 /*
|
|
|
50 Nonzero means inside a new-style backquote
|
|
|
51 with no surrounding parentheses.
|
|
|
52 Fread initializes this to zero, so we need not specbind it
|
|
|
53 or worry about what happens to it when there is an error.
|
|
|
54
|
|
|
55 XEmacs:
|
|
|
56 Nested backquotes are perfectly legal and fail utterly with
|
|
|
57 this silliness. */
|
|
|
58 static int new_backquote_flag, old_backquote_flag;
|
|
|
59 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
|
|
|
60 #endif
|
|
|
61 Lisp_Object Qvariable_domain; /* I18N3 */
|
|
|
62 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
|
|
2548
|
63 Lisp_Object Vload_suppress_alist;
|
|
|
64 Lisp_Object Qload, Qload_internal, Qfset;
|
|
428
|
65
|
|
|
66 /* Hash-table that maps directory names to hashes of their contents. */
|
|
|
67 static Lisp_Object Vlocate_file_hash_table;
|
|
|
68
|
|
|
69 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
|
|
|
70
|
|
|
71 /* See read_escape() for an explanation of this. */
|
|
|
72 #if 0
|
|
|
73 int fail_on_bucky_bit_character_escapes;
|
|
|
74 #endif
|
|
|
75
|
|
|
76 /* This symbol is also used in fns.c */
|
|
|
77 #define FEATUREP_SYNTAX
|
|
|
78
|
|
|
79 #ifdef FEATUREP_SYNTAX
|
|
|
80 Lisp_Object Qfeaturep;
|
|
|
81 #endif
|
|
|
82
|
|
|
83 /* non-zero if inside `load' */
|
|
|
84 int load_in_progress;
|
|
|
85
|
|
|
86 /* Whether Fload_internal() should check whether the .el is newer
|
|
|
87 when loading .elc */
|
|
|
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;
|
|
1123
|
93 /* Whether Fload_internal() should ignore out-of-date .elc files when no
|
|
|
94 suffix is given */
|
|
|
95 int load_ignore_out_of_date_elc_files;
|
|
|
96 /* Always display messages showing when a file is loaded, regardless of
|
|
|
97 whether the flag to `load' tries to suppress them. */
|
|
|
98 int load_always_display_messages;
|
|
|
99 /* Show the full path in loading messages. */
|
|
|
100 int load_show_full_path_in_messages;
|
|
428
|
101
|
|
|
102 /* Search path for files to be loaded. */
|
|
|
103 Lisp_Object Vload_path;
|
|
|
104
|
|
|
105 /* Search path for files when dumping. */
|
|
|
106 /* Lisp_Object Vdump_load_path; */
|
|
|
107
|
|
|
108 /* This is the user-visible association list that maps features to
|
|
|
109 lists of defs in their load files. */
|
|
|
110 Lisp_Object Vload_history;
|
|
|
111
|
|
|
112 /* This is used to build the load history. */
|
|
|
113 Lisp_Object Vcurrent_load_list;
|
|
|
114
|
|
|
115 /* Name of file actually being read by `load'. */
|
|
|
116 Lisp_Object Vload_file_name;
|
|
|
117
|
|
|
118 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
|
|
|
119 our #$ checks are reliable. */
|
|
|
120 Lisp_Object Vload_file_name_internal;
|
|
|
121
|
|
|
122 /* Function to use for reading, in `load' and friends. */
|
|
|
123 Lisp_Object Vload_read_function;
|
|
|
124
|
|
|
125 /* The association list of objects read with the #n=object form.
|
|
|
126 Each member of the list has the form (n . object), and is used to
|
|
|
127 look up the object for the corresponding #n# construct.
|
|
|
128 It must be set to nil before all top-level calls to read0. */
|
|
|
129 Lisp_Object Vread_objects;
|
|
|
130
|
|
|
131 /* Nonzero means load should forcibly load all dynamic doc strings. */
|
|
|
132 /* Note that this always happens (with some special behavior) when
|
|
|
133 purify_flag is set. */
|
|
|
134 static int load_force_doc_strings;
|
|
|
135
|
|
|
136 /* List of descriptors now open for Fload_internal. */
|
|
|
137 static Lisp_Object Vload_descriptor_list;
|
|
|
138
|
|
|
139 /* In order to implement "load_force_doc_strings", we keep
|
|
|
140 a list of all the compiled-function objects and such
|
|
|
141 that we have created in the process of loading this file.
|
|
|
142 See the rant below.
|
|
|
143
|
|
|
144 We specbind this just like Vload_file_name, so there's no
|
|
|
145 problems with recursive loading. */
|
|
|
146 static Lisp_Object Vload_force_doc_string_list;
|
|
|
147
|
|
|
148 /* A resizing-buffer stream used to temporarily hold data while reading */
|
|
|
149 static Lisp_Object Vread_buffer_stream;
|
|
|
150
|
|
|
151 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
152 Lisp_Object Vcurrent_compiled_function_annotation;
|
|
|
153 #endif
|
|
|
154
|
|
|
155 static int load_byte_code_version;
|
|
|
156
|
|
|
157 /* An array describing all known built-in structure types */
|
|
|
158 static structure_type_dynarr *the_structure_type_dynarr;
|
|
|
159
|
|
|
160 #if 0 /* FSF stuff */
|
|
|
161 /* For use within read-from-string (this reader is non-reentrant!!) */
|
|
|
162 static int read_from_string_index;
|
|
|
163 static int read_from_string_limit;
|
|
|
164 #endif
|
|
|
165
|
|
|
166 #if 0 /* More FSF implementation kludges. */
|
|
|
167 /* In order to implement load-force-doc-string, FSF saves the
|
|
|
168 #@-quoted string when it's seen, and goes back and retrieves
|
|
|
169 it later.
|
|
|
170
|
|
|
171 This approach is not only kludgy, but it in general won't work
|
|
|
172 correctly because there's no stack of remembered #@-quoted-strings
|
|
|
173 and those strings don't generally appear in the file in the same
|
|
|
174 order as their #$ references. (Yes, that is amazingly stupid too.
|
|
|
175
|
|
|
176 It would be trivially easy to always encode the #@ string
|
|
|
177 [which is a comment, anyway] in the middle of the (#$ . INT) cons
|
|
|
178 reference. That way, it would be really easy to implement
|
|
|
179 load-force-doc-string in a non-kludgy way by just retrieving the
|
|
|
180 string immediately, because it's delivered on a silver platter.)
|
|
|
181
|
|
|
182 And finally, this stupid approach doesn't work under Mule, or
|
|
|
183 under MS-DOS or Windows NT, or under VMS, or any other place
|
|
|
184 where you either can't do an ftell() or don't get back a byte
|
|
|
185 count.
|
|
|
186
|
|
|
187 Oh, and one more lossage in this approach: If you attempt to
|
|
|
188 dump any ELC files that were compiled with `byte-compile-dynamic'
|
|
|
189 (as opposed to just `byte-compile-dynamic-docstring'), you
|
|
|
190 get hosed. FMH! (as the illustrious JWZ was prone to utter)
|
|
|
191
|
|
|
192 The approach we use is clean, solves all of these problems, and is
|
|
|
193 probably easier to implement anyway. We just save a list of all
|
|
|
194 the containing objects that have (#$ . INT) conses in them (this
|
|
|
195 will only be compiled-function objects and lists), and when the
|
|
|
196 file is finished loading, we go through and fill in all the
|
|
814
|
197 doc strings at once. --ben */
|
|
428
|
198
|
|
|
199 /* This contains the last string skipped with #@. */
|
|
|
200 static char *saved_doc_string;
|
|
|
201 /* Length of buffer allocated in saved_doc_string. */
|
|
|
202 static int saved_doc_string_size;
|
|
|
203 /* Length of actual data in saved_doc_string. */
|
|
|
204 static int saved_doc_string_length;
|
|
|
205 /* This is the file position that string came from. */
|
|
|
206 static int saved_doc_string_position;
|
|
|
207 #endif
|
|
|
208
|
|
1123
|
209 static int locate_file_open_or_access_file (Ibyte *fn, int access_mode);
|
|
428
|
210 EXFUN (Fread_from_string, 3);
|
|
|
211
|
|
|
212 /* When errors are signaled, the actual readcharfun should not be used
|
|
|
213 as an argument if it is an lstream, so that lstreams don't escape
|
|
|
214 to the Lisp level. */
|
|
1261
|
215 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
|
|
|
216 ? (build_msg_string ("internal input stream")) \
|
|
428
|
217 : (x))
|
|
|
218
|
|
|
219
|
|
2268
|
220 static DECLARE_DOESNT_RETURN (read_syntax_error (const char *));
|
|
|
221
|
|
428
|
222 static DOESNT_RETURN
|
|
442
|
223 read_syntax_error (const char *string)
|
|
428
|
224 {
|
|
563
|
225 signal_error (Qinvalid_read_syntax, string, Qunbound);
|
|
428
|
226 }
|
|
|
227
|
|
|
228 static Lisp_Object
|
|
442
|
229 continuable_read_syntax_error (const char *string)
|
|
428
|
230 {
|
|
563
|
231 return signal_continuable_error (Qinvalid_read_syntax, string, Qunbound);
|
|
428
|
232 }
|
|
|
233
|
|
|
234
|
|
|
235 /* Handle unreading and rereading of characters. */
|
|
867
|
236 static Ichar
|
|
428
|
237 readchar (Lisp_Object readcharfun)
|
|
|
238 {
|
|
|
239 /* This function can GC */
|
|
|
240
|
|
|
241 if (BUFFERP (readcharfun))
|
|
|
242 {
|
|
867
|
243 Ichar c;
|
|
428
|
244 struct buffer *b = XBUFFER (readcharfun);
|
|
|
245
|
|
|
246 if (!BUFFER_LIVE_P (b))
|
|
563
|
247 invalid_operation ("Reading from killed buffer", Qunbound);
|
|
428
|
248
|
|
|
249 if (BUF_PT (b) >= BUF_ZV (b))
|
|
|
250 return -1;
|
|
|
251 c = BUF_FETCH_CHAR (b, BUF_PT (b));
|
|
|
252 BUF_SET_PT (b, BUF_PT (b) + 1);
|
|
|
253
|
|
|
254 return c;
|
|
|
255 }
|
|
|
256 else if (LSTREAMP (readcharfun))
|
|
|
257 {
|
|
867
|
258 Ichar c = Lstream_get_ichar (XLSTREAM (readcharfun));
|
|
428
|
259 #ifdef DEBUG_XEMACS /* testing Mule */
|
|
|
260 static int testing_mule = 0; /* Change via debugger */
|
|
444
|
261 if (testing_mule)
|
|
|
262 {
|
|
|
263 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
|
|
|
264 else if (c == '\n') stderr_out ("\\n\n");
|
|
|
265 else stderr_out ("\\%o ", c);
|
|
|
266 }
|
|
|
267 #endif /* testing Mule */
|
|
428
|
268 return c;
|
|
|
269 }
|
|
|
270 else if (MARKERP (readcharfun))
|
|
|
271 {
|
|
867
|
272 Ichar c;
|
|
665
|
273 Charbpos mpos = marker_position (readcharfun);
|
|
428
|
274 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
|
|
|
275
|
|
|
276 if (mpos >= BUF_ZV (inbuffer))
|
|
|
277 return -1;
|
|
|
278 c = BUF_FETCH_CHAR (inbuffer, mpos);
|
|
|
279 set_marker_position (readcharfun, mpos + 1);
|
|
|
280 return c;
|
|
|
281 }
|
|
|
282 else
|
|
|
283 {
|
|
|
284 Lisp_Object tem = call0 (readcharfun);
|
|
|
285
|
|
|
286 if (!CHAR_OR_CHAR_INTP (tem))
|
|
|
287 return -1;
|
|
|
288 return XCHAR_OR_CHAR_INT (tem);
|
|
|
289 }
|
|
|
290 }
|
|
|
291
|
|
|
292 /* Unread the character C in the way appropriate for the stream READCHARFUN.
|
|
|
293 If the stream is a user function, call it with the char as argument. */
|
|
|
294
|
|
|
295 static void
|
|
867
|
296 unreadchar (Lisp_Object readcharfun, Ichar c)
|
|
428
|
297 {
|
|
|
298 if (c == -1)
|
|
|
299 /* Don't back up the pointer if we're unreading the end-of-input mark,
|
|
|
300 since readchar didn't advance it when we read it. */
|
|
|
301 ;
|
|
|
302 else if (BUFFERP (readcharfun))
|
|
|
303 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
|
|
|
304 else if (LSTREAMP (readcharfun))
|
|
|
305 {
|
|
867
|
306 Lstream_unget_ichar (XLSTREAM (readcharfun), c);
|
|
428
|
307 #ifdef DEBUG_XEMACS /* testing Mule */
|
|
|
308 {
|
|
|
309 static int testing_mule = 0; /* Set this using debugger */
|
|
|
310 if (testing_mule)
|
|
|
311 fprintf (stderr,
|
|
|
312 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
|
|
|
313 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
|
|
|
314 }
|
|
|
315 #endif
|
|
|
316 }
|
|
|
317 else if (MARKERP (readcharfun))
|
|
|
318 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
|
|
|
319 else
|
|
|
320 call1 (readcharfun, make_char (c));
|
|
|
321 }
|
|
|
322
|
|
|
323 static Lisp_Object read0 (Lisp_Object readcharfun);
|
|
|
324 static Lisp_Object read1 (Lisp_Object readcharfun);
|
|
|
325 static Lisp_Object read_list (Lisp_Object readcharfun,
|
|
867
|
326 Ichar terminator,
|
|
428
|
327 int allow_dotted_lists,
|
|
|
328 int check_for_doc_references);
|
|
|
329
|
|
|
330 static void readevalloop (Lisp_Object readcharfun,
|
|
|
331 Lisp_Object sourcefile,
|
|
|
332 Lisp_Object (*evalfun) (Lisp_Object),
|
|
|
333 int printflag);
|
|
|
334
|
|
|
335 static Lisp_Object
|
|
|
336 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
|
|
|
337 {
|
|
|
338 Lstream_close (XLSTREAM (stream));
|
|
|
339 return Qnil;
|
|
|
340 }
|
|
|
341
|
|
2548
|
342 /* Check if NONRELOC/RELOC (an absolute filename) is suppressed according
|
|
|
343 to load-suppress-alist. */
|
|
|
344 static int
|
|
|
345 check_if_suppressed (Ibyte *nonreloc, Lisp_Object reloc)
|
|
|
346 {
|
|
|
347 Bytecount len;
|
|
|
348
|
|
|
349 if (!NILP (reloc))
|
|
|
350 {
|
|
|
351 nonreloc = XSTRING_DATA (reloc);
|
|
|
352 len = XSTRING_LENGTH (reloc);
|
|
|
353 }
|
|
|
354 else
|
|
|
355 len = qxestrlen (nonreloc);
|
|
|
356
|
|
|
357 if (len >= 4 && !qxestrcmp_ascii (nonreloc + len - 4, ".elc"))
|
|
|
358 len -= 4;
|
|
|
359 else if (len >= 3 && !qxestrcmp_ascii (nonreloc + len - 3, ".el"))
|
|
|
360 len -= 3;
|
|
|
361
|
|
2567
|
362 {
|
|
|
363 EXTERNAL_LIST_LOOP_2 (acons, Vload_suppress_alist)
|
|
|
364 {
|
|
|
365 if (CONSP (acons) && STRINGP (XCAR (acons)))
|
|
|
366 {
|
|
|
367 Lisp_Object name = XCAR (acons);
|
|
|
368 if (XSTRING_LENGTH (name) == len &&
|
|
|
369 !memcmp (XSTRING_DATA (name), nonreloc, len))
|
|
|
370 {
|
|
|
371 struct gcpro gcpro1;
|
|
|
372 Lisp_Object val;
|
|
|
373
|
|
|
374 GCPRO1 (reloc);
|
|
|
375 val = Feval (XCDR (acons));
|
|
|
376 UNGCPRO;
|
|
|
377
|
|
|
378 if (!NILP (val))
|
|
|
379 return 1;
|
|
|
380 }
|
|
|
381 }
|
|
|
382 }
|
|
|
383 }
|
|
2548
|
384
|
|
|
385 return 0;
|
|
|
386 }
|
|
|
387
|
|
428
|
388 /* The plague is coming.
|
|
|
389
|
|
|
390 Ring around the rosy, pocket full of posy,
|
|
|
391 Ashes ashes, they all fall down.
|
|
|
392 */
|
|
|
393 void
|
|
|
394 ebolify_bytecode_constants (Lisp_Object vector)
|
|
|
395 {
|
|
|
396 int len = XVECTOR_LENGTH (vector);
|
|
|
397 int i;
|
|
|
398
|
|
|
399 for (i = 0; i < len; i++)
|
|
|
400 {
|
|
|
401 Lisp_Object el = XVECTOR_DATA (vector)[i];
|
|
|
402
|
|
|
403 /* We don't check for `eq', `equal', and the others that have
|
|
|
404 bytecode opcodes. This might lose if someone passes #'eq or
|
|
|
405 something to `funcall', but who would really do that? As
|
|
|
406 they say in law, we've made a "good-faith effort" to
|
|
|
407 unfuckify ourselves. And doing it this way avoids screwing
|
|
|
408 up args to `make-hash-table' and such. As it is, we have to
|
|
|
409 add an extra Ebola check in decode_weak_list_type(). --ben */
|
|
|
410 if (EQ (el, Qassoc)) el = Qold_assoc;
|
|
|
411 else if (EQ (el, Qdelq)) el = Qold_delq;
|
|
|
412 #if 0
|
|
|
413 /* I think this is a bad idea because it will probably mess
|
|
|
414 with keymap code. */
|
|
|
415 else if (EQ (el, Qdelete)) el = Qold_delete;
|
|
|
416 #endif
|
|
|
417 else if (EQ (el, Qrassq)) el = Qold_rassq;
|
|
|
418 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
|
|
|
419
|
|
|
420 XVECTOR_DATA (vector)[i] = el;
|
|
|
421 }
|
|
|
422 }
|
|
|
423
|
|
|
424 static Lisp_Object
|
|
558
|
425 pas_de_holgazan_ici (int fd, Lisp_Object victim)
|
|
428
|
426 {
|
|
|
427 Lisp_Object tem;
|
|
|
428 EMACS_INT pos;
|
|
|
429
|
|
|
430 if (!INTP (XCDR (victim)))
|
|
563
|
431 invalid_byte_code ("Bogus doc string reference", victim);
|
|
428
|
432 pos = XINT (XCDR (victim));
|
|
|
433 if (pos < 0)
|
|
|
434 pos = -pos; /* kludge to mark a user variable */
|
|
814
|
435 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal, 0);
|
|
428
|
436 if (!STRINGP (tem))
|
|
563
|
437 signal_error_1 (Qinvalid_byte_code, tem);
|
|
428
|
438 return tem;
|
|
|
439 }
|
|
|
440
|
|
|
441 static Lisp_Object
|
|
|
442 load_force_doc_string_unwind (Lisp_Object oldlist)
|
|
|
443 {
|
|
|
444 struct gcpro gcpro1;
|
|
|
445 Lisp_Object list = Vload_force_doc_string_list;
|
|
|
446 Lisp_Object tail;
|
|
|
447 int fd = XINT (XCAR (Vload_descriptor_list));
|
|
|
448
|
|
|
449 GCPRO1 (list);
|
|
|
450 /* restore the old value first just in case an error occurs. */
|
|
|
451 Vload_force_doc_string_list = oldlist;
|
|
|
452
|
|
|
453 LIST_LOOP (tail, list)
|
|
|
454 {
|
|
|
455 Lisp_Object john = Fcar (tail);
|
|
|
456 if (CONSP (john))
|
|
|
457 {
|
|
|
458 assert (CONSP (XCAR (john)));
|
|
|
459 assert (!purify_flag); /* should have been handled in read_list() */
|
|
558
|
460 XCAR (john) = pas_de_holgazan_ici (fd, XCAR (john));
|
|
428
|
461 }
|
|
|
462 else
|
|
|
463 {
|
|
|
464 Lisp_Object doc;
|
|
|
465
|
|
|
466 assert (COMPILED_FUNCTIONP (john));
|
|
|
467 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
|
|
|
468 {
|
|
|
469 struct gcpro ngcpro1;
|
|
558
|
470 Lisp_Object juan = (pas_de_holgazan_ici
|
|
814
|
471 (fd,
|
|
|
472 XCOMPILED_FUNCTION (john)->instructions));
|
|
428
|
473 Lisp_Object ivan;
|
|
|
474
|
|
|
475 NGCPRO1 (juan);
|
|
|
476 ivan = Fread (juan);
|
|
|
477 if (!CONSP (ivan))
|
|
563
|
478 invalid_byte_code ("invalid lazy-loaded byte code", ivan);
|
|
428
|
479 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
|
|
|
480 /* v18 or v19 bytecode file. Need to Ebolify. */
|
|
|
481 if (XCOMPILED_FUNCTION (john)->flags.ebolified
|
|
|
482 && VECTORP (XCDR (ivan)))
|
|
|
483 ebolify_bytecode_constants (XCDR (ivan));
|
|
|
484 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
|
|
|
485 NUNGCPRO;
|
|
|
486 }
|
|
|
487 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
|
|
|
488 if (CONSP (doc))
|
|
|
489 {
|
|
|
490 assert (!purify_flag); /* should have been handled in
|
|
|
491 read_compiled_function() */
|
|
558
|
492 doc = pas_de_holgazan_ici (fd, doc);
|
|
428
|
493 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
|
|
|
494 doc);
|
|
|
495 }
|
|
|
496 }
|
|
|
497 }
|
|
|
498
|
|
|
499 if (!NILP (list))
|
|
|
500 free_list (list);
|
|
|
501
|
|
|
502 UNGCPRO;
|
|
|
503 return Qnil;
|
|
|
504 }
|
|
|
505
|
|
|
506 /* Close all descriptors in use for Fload_internal.
|
|
|
507 This is used when starting a subprocess. */
|
|
|
508
|
|
|
509 void
|
|
|
510 close_load_descs (void)
|
|
|
511 {
|
|
|
512 Lisp_Object tail;
|
|
|
513 LIST_LOOP (tail, Vload_descriptor_list)
|
|
771
|
514 retry_close (XINT (XCAR (tail)));
|
|
428
|
515 }
|
|
|
516
|
|
|
517 #ifdef I18N3
|
|
|
518 Lisp_Object Vfile_domain;
|
|
|
519 #endif /* I18N3 */
|
|
|
520
|
|
|
521 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
|
|
|
522 Execute a file of Lisp code named FILE; no coding-system frobbing.
|
|
|
523 This function is identical to `load' except for the handling of the
|
|
|
524 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
|
|
|
525 support is not present, both functions are identical and ignore the
|
|
|
526 CODESYS and USED-CODESYS arguments.)
|
|
|
527
|
|
|
528 If support for Mule exists in this Emacs, the file is decoded
|
|
|
529 according to CODESYS; if omitted, no conversion happens. If
|
|
|
530 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
|
|
|
531 system that was used for the decoding is stored into it. It will in
|
|
|
532 general be different from CODESYS if CODESYS specifies automatic
|
|
|
533 encoding detection or end-of-line detection.
|
|
|
534 */
|
|
444
|
535 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
|
|
428
|
536 {
|
|
|
537 /* This function can GC */
|
|
|
538 int fd = -1;
|
|
|
539 int speccount = specpdl_depth ();
|
|
|
540 int source_only = 0;
|
|
1123
|
541 /* NEWER and OLDER are filenames w/o directory, used in loading messages
|
|
|
542 to e.g. warn of newer .el files when the .elc is being loaded. */
|
|
428
|
543 Lisp_Object newer = Qnil;
|
|
1123
|
544 Lisp_Object older = Qnil;
|
|
428
|
545 Lisp_Object handler = Qnil;
|
|
|
546 Lisp_Object found = Qnil;
|
|
1292
|
547 Lisp_Object retval;
|
|
1123
|
548 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
428
|
549 int reading_elc = 0;
|
|
780
|
550 int from_require = EQ (nomessage, Qrequire);
|
|
1261
|
551 int message_p = NILP (nomessage) || load_always_display_messages;
|
|
428
|
552 struct stat s1, s2;
|
|
1261
|
553 Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
|
|
|
554 int i;
|
|
1292
|
555 PROFILE_DECLARE ();
|
|
428
|
556
|
|
1266
|
557 GCPRO4 (file, newer, older, found);
|
|
428
|
558 CHECK_STRING (file);
|
|
|
559
|
|
1292
|
560 PROFILE_RECORD_ENTERING_SECTION (Qload_internal);
|
|
|
561
|
|
428
|
562 /* If file name is magic, call the handler. */
|
|
|
563 handler = Ffind_file_name_handler (file, Qload);
|
|
|
564 if (!NILP (handler))
|
|
1292
|
565 {
|
|
|
566 retval = call5 (handler, Qload, file, noerror, nomessage, nosuffix);
|
|
|
567 goto done;
|
|
|
568 }
|
|
428
|
569
|
|
|
570 /* Do this after the handler to avoid
|
|
|
571 the need to gcpro noerror, nomessage and nosuffix.
|
|
|
572 (Below here, we care only whether they are nil or not.) */
|
|
|
573 file = Fsubstitute_in_file_name (file);
|
|
|
574 if (!NILP (used_codesys))
|
|
|
575 CHECK_SYMBOL (used_codesys);
|
|
|
576
|
|
1261
|
577 if (noninteractive)
|
|
|
578 {
|
|
|
579 for (i = 0; i < load_in_progress * 2; i++)
|
|
|
580 spaces[i] = ' ';
|
|
|
581 spaces[i] = '\0';
|
|
|
582 }
|
|
|
583 else
|
|
|
584 spaces[0] = '\0';
|
|
|
585
|
|
428
|
586 /* Avoid weird lossage with null string as arg,
|
|
|
587 since it would try to load a directory as a Lisp file.
|
|
|
588 Unix truly sucks. */
|
|
|
589 if (XSTRING_LENGTH (file) > 0)
|
|
|
590 {
|
|
867
|
591 Ibyte *foundstr;
|
|
428
|
592 int foundlen;
|
|
|
593
|
|
|
594 fd = locate_file (Vload_path, file,
|
|
|
595 ((!NILP (nosuffix)) ? Qnil :
|
|
|
596 build_string (load_ignore_elc_files ? ".el:" :
|
|
|
597 ".elc:.el:")),
|
|
|
598 &found,
|
|
|
599 -1);
|
|
|
600
|
|
|
601 if (fd < 0)
|
|
|
602 {
|
|
444
|
603 if (NILP (noerror))
|
|
563
|
604 signal_error (Qfile_error, "Cannot open load file", file);
|
|
428
|
605 else
|
|
|
606 {
|
|
1292
|
607 retval = Qnil;
|
|
|
608 goto done;
|
|
428
|
609 }
|
|
|
610 }
|
|
|
611
|
|
2367
|
612 foundstr = alloca_ibytes (XSTRING_LENGTH (found) + 1);
|
|
771
|
613 qxestrcpy (foundstr, XSTRING_DATA (found));
|
|
|
614 foundlen = qxestrlen (foundstr);
|
|
428
|
615
|
|
|
616 /* The omniscient JWZ thinks this is worthless, but I beg to
|
|
|
617 differ. --ben */
|
|
|
618 if (load_ignore_elc_files)
|
|
1123
|
619 newer = Ffile_name_nondirectory (found);
|
|
|
620 else if ((load_warn_when_source_newer ||
|
|
|
621 load_ignore_out_of_date_elc_files) &&
|
|
428
|
622 !memcmp (".elc", foundstr + foundlen - 4, 4))
|
|
|
623 {
|
|
771
|
624 if (! qxe_fstat (fd, &s1)) /* can't fail, right? */
|
|
428
|
625 {
|
|
|
626 int result;
|
|
|
627 /* temporarily hack the 'c' off the end of the filename */
|
|
|
628 foundstr[foundlen - 1] = '\0';
|
|
771
|
629 result = qxe_stat (foundstr, &s2);
|
|
428
|
630 if (result >= 0 &&
|
|
|
631 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
|
|
1123
|
632 {
|
|
|
633 /* .elc exists and is out-of-date wrt .el */
|
|
|
634 Lisp_Object el_name = make_string (foundstr, foundlen - 1);
|
|
|
635 struct gcpro nngcpro1;
|
|
|
636 NNGCPRO1 (el_name);
|
|
|
637 newer = Ffile_name_nondirectory (el_name);
|
|
|
638 if (load_ignore_out_of_date_elc_files)
|
|
|
639 {
|
|
|
640 int newfd =
|
|
|
641 locate_file_open_or_access_file
|
|
|
642 (XSTRING_DATA (el_name), -1);
|
|
|
643
|
|
|
644 if (newfd >= 0)
|
|
|
645 {
|
|
|
646 older = Ffile_name_nondirectory (found);
|
|
|
647 found = el_name;
|
|
|
648 retry_close (fd);
|
|
|
649 fd = newfd;
|
|
|
650 }
|
|
|
651 }
|
|
|
652 NNUNGCPRO;
|
|
|
653 }
|
|
428
|
654 /* put the 'c' back on (kludge-o-rama) */
|
|
|
655 foundstr[foundlen - 1] = 'c';
|
|
|
656 }
|
|
|
657 }
|
|
|
658 else if (load_warn_when_source_only &&
|
|
|
659 /* `found' ends in ".el" */
|
|
|
660 !memcmp (".el", foundstr + foundlen - 3, 3) &&
|
|
|
661 /* `file' does not end in ".el" */
|
|
|
662 memcmp (".el",
|
|
|
663 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
|
|
|
664 3))
|
|
1123
|
665 source_only = 1;
|
|
428
|
666
|
|
|
667 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
|
|
|
668 reading_elc = 1;
|
|
|
669 }
|
|
|
670
|
|
1123
|
671 #define PRINT_LOADING_MESSAGE_1(loading, done) \
|
|
|
672 do { \
|
|
|
673 if (load_ignore_elc_files) \
|
|
|
674 { \
|
|
|
675 if (message_p) \
|
|
1261
|
676 message (loading done, spaces, \
|
|
1123
|
677 XSTRING_DATA (load_show_full_path_in_messages ? \
|
|
|
678 found : newer)); \
|
|
|
679 } \
|
|
|
680 else if (!NILP (older)) \
|
|
|
681 { \
|
|
|
682 assert (load_ignore_out_of_date_elc_files); \
|
|
1261
|
683 message (loading done " (file %s is out-of-date)", spaces, \
|
|
1123
|
684 XSTRING_DATA (load_show_full_path_in_messages ? \
|
|
|
685 found : newer), \
|
|
|
686 XSTRING_DATA (older)); \
|
|
|
687 } \
|
|
|
688 else if (!NILP (newer)) \
|
|
1261
|
689 message (loading done " (file %s is newer)", spaces, \
|
|
1123
|
690 XSTRING_DATA (load_show_full_path_in_messages ? \
|
|
|
691 found : file), \
|
|
|
692 XSTRING_DATA (newer)); \
|
|
|
693 else if (source_only) \
|
|
1261
|
694 message (loading done " (file %s.elc does not exist)", spaces, \
|
|
1123
|
695 XSTRING_DATA (load_show_full_path_in_messages ? \
|
|
|
696 found : file), \
|
|
|
697 XSTRING_DATA (Ffile_name_nondirectory (file))); \
|
|
|
698 else if (message_p) \
|
|
1261
|
699 message (loading done, spaces, \
|
|
1123
|
700 XSTRING_DATA (load_show_full_path_in_messages ? \
|
|
|
701 found : file)); \
|
|
428
|
702 } while (0)
|
|
|
703
|
|
1261
|
704 #define PRINT_LOADING_MESSAGE(done) \
|
|
|
705 do { \
|
|
|
706 if (from_require) \
|
|
|
707 PRINT_LOADING_MESSAGE_1 ("%sRequiring %s...", done); \
|
|
|
708 else \
|
|
|
709 PRINT_LOADING_MESSAGE_1 ("%sLoading %s...", done); \
|
|
780
|
710 } while (0)
|
|
|
711
|
|
428
|
712 PRINT_LOADING_MESSAGE ("");
|
|
|
713
|
|
|
714 {
|
|
|
715 /* Lisp_Object's must be malloc'ed, not stack-allocated */
|
|
|
716 Lisp_Object lispstream = Qnil;
|
|
442
|
717 const int block_size = 8192;
|
|
428
|
718 struct gcpro ngcpro1;
|
|
|
719
|
|
|
720 NGCPRO1 (lispstream);
|
|
|
721 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
|
|
|
722 /* 64K is used for normal files; 8K should be OK here because Lisp
|
|
|
723 files aren't really all that big. */
|
|
|
724 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
|
|
|
725 block_size);
|
|
771
|
726 lispstream = make_coding_input_stream
|
|
|
727 (XLSTREAM (lispstream), get_coding_system_for_text_file (codesys, 1),
|
|
800
|
728 CODING_DECODE, 0);
|
|
428
|
729 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
|
|
|
730 block_size);
|
|
|
731 /* NOTE: Order of these is very important. Don't rearrange them. */
|
|
853
|
732 internal_bind_int (&load_in_progress, 1 + load_in_progress);
|
|
428
|
733 record_unwind_protect (load_unwind, lispstream);
|
|
853
|
734 internal_bind_lisp_object (&Vload_descriptor_list,
|
|
|
735 Fcons (make_int (fd), Vload_descriptor_list));
|
|
|
736 internal_bind_lisp_object (&Vload_file_name_internal, found);
|
|
|
737 /* this is not a simple internal_bind. */
|
|
428
|
738 record_unwind_protect (load_force_doc_string_unwind,
|
|
|
739 Vload_force_doc_string_list);
|
|
853
|
740 Vload_force_doc_string_list = Qnil;
|
|
2548
|
741 internal_bind_lisp_object (&Vload_file_name, found);
|
|
428
|
742 #ifdef I18N3
|
|
853
|
743 /* set it to nil; a call to #'domain will set it. */
|
|
|
744 internal_bind_lisp_object (&Vfile_domain, Qnil);
|
|
428
|
745 #endif
|
|
|
746
|
|
|
747 /* Now determine what sort of ELC file we're reading in. */
|
|
853
|
748 internal_bind_int (&load_byte_code_version, load_byte_code_version);
|
|
428
|
749 if (reading_elc)
|
|
|
750 {
|
|
|
751 char elc_header[8];
|
|
|
752 int num_read;
|
|
|
753
|
|
|
754 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
|
|
|
755 if (num_read < 8
|
|
|
756 || strncmp (elc_header, ";ELC", 4))
|
|
|
757 {
|
|
|
758 /* Huh? Probably not a valid ELC file. */
|
|
|
759 load_byte_code_version = 100; /* no Ebolification needed */
|
|
|
760 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
|
|
|
761 }
|
|
|
762 else
|
|
|
763 load_byte_code_version = elc_header[4];
|
|
|
764 }
|
|
|
765 else
|
|
|
766 load_byte_code_version = 100; /* no Ebolification needed */
|
|
|
767
|
|
|
768 readevalloop (lispstream, file, Feval, 0);
|
|
|
769 if (!NILP (used_codesys))
|
|
|
770 Fset (used_codesys,
|
|
|
771 XCODING_SYSTEM_NAME
|
|
771
|
772 (coding_stream_detected_coding_system (XLSTREAM (lispstream))));
|
|
|
773 unbind_to (speccount);
|
|
428
|
774
|
|
|
775 NUNGCPRO;
|
|
|
776 }
|
|
|
777
|
|
|
778 {
|
|
|
779 Lisp_Object tem;
|
|
|
780 /* #### Disgusting kludge */
|
|
|
781 /* Run any load-hooks for this file. */
|
|
|
782 /* #### An even more disgusting kludge. There is horrible code */
|
|
|
783 /* that is relying on the fact that dumped lisp files are found */
|
|
|
784 /* via `load-path' search. */
|
|
|
785 Lisp_Object name = file;
|
|
|
786
|
|
1123
|
787 if (!NILP (Ffile_name_absolute_p (file)))
|
|
|
788 name = Ffile_name_nondirectory (file);
|
|
428
|
789
|
|
1261
|
790 tem = Fassoc (name, Vafter_load_alist);
|
|
428
|
791 if (!NILP (tem))
|
|
|
792 {
|
|
|
793 struct gcpro ngcpro1;
|
|
|
794
|
|
|
795 NGCPRO1 (tem);
|
|
|
796 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
|
|
|
797 tem = Fcons (Qprogn, Fcdr (tem));
|
|
|
798 Feval (tem);
|
|
|
799 NUNGCPRO;
|
|
|
800 }
|
|
|
801 }
|
|
|
802
|
|
|
803 if (!noninteractive)
|
|
|
804 PRINT_LOADING_MESSAGE ("done");
|
|
|
805
|
|
1292
|
806 retval = Qt;
|
|
|
807 done:
|
|
|
808 PROFILE_RECORD_EXITING_SECTION (Qload_internal);
|
|
428
|
809 UNGCPRO;
|
|
1292
|
810 return retval;
|
|
428
|
811 }
|
|
|
812
|
|
|
813
|
|
|
814 /* ------------------------------- */
|
|
|
815 /* locate_file */
|
|
|
816 /* ------------------------------- */
|
|
|
817
|
|
|
818 static int
|
|
|
819 decode_mode_1 (Lisp_Object mode)
|
|
|
820 {
|
|
|
821 if (EQ (mode, Qexists))
|
|
|
822 return F_OK;
|
|
|
823 else if (EQ (mode, Qexecutable))
|
|
|
824 return X_OK;
|
|
|
825 else if (EQ (mode, Qwritable))
|
|
|
826 return W_OK;
|
|
|
827 else if (EQ (mode, Qreadable))
|
|
|
828 return R_OK;
|
|
|
829 else if (INTP (mode))
|
|
|
830 {
|
|
|
831 check_int_range (XINT (mode), 0, 7);
|
|
|
832 return XINT (mode);
|
|
|
833 }
|
|
|
834 else
|
|
563
|
835 invalid_argument ("Invalid value", mode);
|
|
428
|
836 return 0; /* unreached */
|
|
|
837 }
|
|
|
838
|
|
|
839 static int
|
|
|
840 decode_mode (Lisp_Object mode)
|
|
|
841 {
|
|
|
842 if (NILP (mode))
|
|
|
843 return R_OK;
|
|
|
844 else if (CONSP (mode))
|
|
|
845 {
|
|
|
846 int mask = 0;
|
|
2367
|
847 EXTERNAL_LIST_LOOP_2 (elt, mode)
|
|
|
848 mask |= decode_mode_1 (elt);
|
|
428
|
849 return mask;
|
|
|
850 }
|
|
|
851 else
|
|
|
852 return decode_mode_1 (mode);
|
|
|
853 }
|
|
|
854
|
|
|
855 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
|
|
|
856 Search for FILENAME through PATH-LIST.
|
|
|
857
|
|
|
858 If SUFFIXES is non-nil, it should be a list of suffixes to append to
|
|
|
859 file name when searching.
|
|
|
860
|
|
|
861 If MODE is non-nil, it should be a symbol or a list of symbol representing
|
|
|
862 requirements. Allowed symbols are `exists', `executable', `writable', and
|
|
|
863 `readable'. If MODE is nil, it defaults to `readable'.
|
|
|
864
|
|
2548
|
865 Filenames are checked against `load-suppress-alist' to determine if they
|
|
|
866 should be ignored.
|
|
|
867
|
|
428
|
868 `locate-file' keeps hash tables of the directories it searches through,
|
|
|
869 in order to speed things up. It tries valiantly to not get confused in
|
|
|
870 the face of a changing and unpredictable environment, but can occasionally
|
|
|
871 get tripped up. In this case, you will have to call
|
|
|
872 `locate-file-clear-hashing' to get it back on track. See that function
|
|
|
873 for details.
|
|
|
874 */
|
|
|
875 (filename, path_list, suffixes, mode))
|
|
|
876 {
|
|
|
877 /* This function can GC */
|
|
|
878 Lisp_Object tp;
|
|
|
879
|
|
|
880 CHECK_STRING (filename);
|
|
|
881
|
|
|
882 if (LISTP (suffixes))
|
|
|
883 {
|
|
2367
|
884 EXTERNAL_LIST_LOOP_2 (elt, suffixes)
|
|
|
885 CHECK_STRING (elt);
|
|
428
|
886 }
|
|
|
887 else
|
|
|
888 CHECK_STRING (suffixes);
|
|
|
889
|
|
|
890 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
|
|
|
891 return tp;
|
|
|
892 }
|
|
|
893
|
|
|
894 /* Recalculate the hash table for the given string. DIRECTORY should
|
|
|
895 better have been through Fexpand_file_name() by now. */
|
|
|
896
|
|
|
897 static Lisp_Object
|
|
|
898 locate_file_refresh_hashing (Lisp_Object directory)
|
|
|
899 {
|
|
|
900 Lisp_Object hash =
|
|
771
|
901 make_directory_hash_table (XSTRING_DATA (directory));
|
|
428
|
902
|
|
|
903 if (!NILP (hash))
|
|
|
904 Fputhash (directory, hash, Vlocate_file_hash_table);
|
|
|
905 return hash;
|
|
|
906 }
|
|
|
907
|
|
|
908 /* find the hash table for the given directory, recalculating if necessary */
|
|
|
909
|
|
|
910 static Lisp_Object
|
|
|
911 locate_file_find_directory_hash_table (Lisp_Object directory)
|
|
|
912 {
|
|
|
913 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
|
|
|
914 if (NILP (hash))
|
|
|
915 return locate_file_refresh_hashing (directory);
|
|
|
916 else
|
|
|
917 return hash;
|
|
|
918 }
|
|
|
919
|
|
|
920 /* The SUFFIXES argument in any of the locate_file* functions can be
|
|
|
921 nil, a list, or a string (for backward compatibility), with the
|
|
|
922 following semantics:
|
|
|
923
|
|
|
924 a) nil - no suffix, just search for file name intact
|
|
|
925 (semantically different from "empty suffix list", which
|
|
|
926 would be meaningless.)
|
|
|
927 b) list - list of suffixes to append to file name. Each of these
|
|
|
928 must be a string.
|
|
|
929 c) string - colon-separated suffixes to append to file name (backward
|
|
|
930 compatibility).
|
|
|
931
|
|
|
932 All of this got hairy, so I decided to use a mapper. Calling a
|
|
|
933 function for each suffix shouldn't slow things down, since
|
|
|
934 locate_file is rarely called with enough suffixes for funcalls to
|
|
|
935 make any difference. */
|
|
|
936
|
|
|
937 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
|
|
|
938 char * containing the current file name, and ARG. Mapping stops when
|
|
|
939 FUN returns non-zero. */
|
|
|
940 static void
|
|
|
941 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
|
|
867
|
942 int (*fun) (Ibyte *, void *),
|
|
428
|
943 void *arg)
|
|
|
944 {
|
|
|
945 /* This function can GC */
|
|
867
|
946 Ibyte *fn;
|
|
428
|
947 int fn_len, max;
|
|
|
948
|
|
|
949 /* Calculate maximum size of any filename made from
|
|
|
950 this path element/specified file name and any possible suffix. */
|
|
|
951 if (CONSP (suffixes))
|
|
|
952 {
|
|
|
953 /* We must traverse the list, so why not do it right. */
|
|
|
954 Lisp_Object tail;
|
|
|
955 max = 0;
|
|
|
956 LIST_LOOP (tail, suffixes)
|
|
|
957 {
|
|
|
958 if (XSTRING_LENGTH (XCAR (tail)) > max)
|
|
|
959 max = XSTRING_LENGTH (XCAR (tail));
|
|
|
960 }
|
|
|
961 }
|
|
|
962 else if (NILP (suffixes))
|
|
|
963 max = 0;
|
|
|
964 else
|
|
|
965 /* Just take the easy way out */
|
|
|
966 max = XSTRING_LENGTH (suffixes);
|
|
|
967
|
|
|
968 fn_len = XSTRING_LENGTH (filename);
|
|
2367
|
969 fn = alloca_ibytes (max + fn_len + 1);
|
|
771
|
970 memcpy (fn, XSTRING_DATA (filename), fn_len);
|
|
428
|
971
|
|
|
972 /* Loop over suffixes. */
|
|
|
973 if (!STRINGP (suffixes))
|
|
|
974 {
|
|
|
975 if (NILP (suffixes))
|
|
|
976 {
|
|
|
977 /* Case a) discussed in the comment above. */
|
|
|
978 fn[fn_len] = 0;
|
|
|
979 if ((*fun) (fn, arg))
|
|
|
980 return;
|
|
|
981 }
|
|
|
982 else
|
|
|
983 {
|
|
|
984 /* Case b) */
|
|
|
985 Lisp_Object tail;
|
|
|
986 LIST_LOOP (tail, suffixes)
|
|
|
987 {
|
|
|
988 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
|
|
|
989 XSTRING_LENGTH (XCAR (tail)));
|
|
|
990 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
|
|
|
991 if ((*fun) (fn, arg))
|
|
|
992 return;
|
|
|
993 }
|
|
|
994 }
|
|
|
995 }
|
|
|
996 else
|
|
|
997 {
|
|
|
998 /* Case c) */
|
|
867
|
999 const Ibyte *nsuffix = XSTRING_DATA (suffixes);
|
|
428
|
1000
|
|
|
1001 while (1)
|
|
|
1002 {
|
|
867
|
1003 Ibyte *esuffix = qxestrchr (nsuffix, ':');
|
|
771
|
1004 Bytecount lsuffix = esuffix ? esuffix - nsuffix :
|
|
|
1005 qxestrlen (nsuffix);
|
|
428
|
1006
|
|
|
1007 /* Concatenate path element/specified name with the suffix. */
|
|
771
|
1008 qxestrncpy (fn + fn_len, nsuffix, lsuffix);
|
|
428
|
1009 fn[fn_len + lsuffix] = 0;
|
|
|
1010
|
|
|
1011 if ((*fun) (fn, arg))
|
|
|
1012 return;
|
|
|
1013
|
|
|
1014 /* Advance to next suffix. */
|
|
|
1015 if (esuffix == 0)
|
|
|
1016 break;
|
|
|
1017 nsuffix += lsuffix + 1;
|
|
|
1018 }
|
|
|
1019 }
|
|
|
1020 }
|
|
|
1021
|
|
771
|
1022 struct locate_file_in_directory_mapper_closure
|
|
|
1023 {
|
|
428
|
1024 int fd;
|
|
|
1025 Lisp_Object *storeptr;
|
|
|
1026 int mode;
|
|
|
1027 };
|
|
|
1028
|
|
1123
|
1029 /* open() or access() a file to be returned by locate_file(). if
|
|
|
1030 ACCESS_MODE >= 0, do an access() with that mode, else open(). Does
|
|
|
1031 various magic, e.g. opening the file read-only and binary and setting
|
|
|
1032 the close-on-exec flag on the file. */
|
|
|
1033
|
|
|
1034 static int
|
|
|
1035 locate_file_open_or_access_file (Ibyte *fn, int access_mode)
|
|
|
1036 {
|
|
|
1037 int val;
|
|
|
1038
|
|
|
1039 /* Check that we can access or open it. */
|
|
|
1040 if (access_mode >= 0)
|
|
|
1041 val = qxe_access (fn, access_mode);
|
|
|
1042 else
|
|
|
1043 {
|
|
|
1044 val = qxe_open (fn, O_RDONLY | OPEN_BINARY, 0);
|
|
|
1045
|
|
|
1046 #ifndef WIN32_NATIVE
|
|
|
1047 if (val >= 0)
|
|
|
1048 /* If we actually opened the file, set close-on-exec flag
|
|
|
1049 on the new descriptor so that subprocesses can't whack
|
|
|
1050 at it. */
|
|
|
1051 (void) fcntl (val, F_SETFD, FD_CLOEXEC);
|
|
|
1052 #endif
|
|
|
1053 }
|
|
|
1054
|
|
|
1055 return val;
|
|
|
1056 }
|
|
|
1057
|
|
428
|
1058 static int
|
|
867
|
1059 locate_file_in_directory_mapper (Ibyte *fn, void *arg)
|
|
428
|
1060 {
|
|
|
1061 struct locate_file_in_directory_mapper_closure *closure =
|
|
771
|
1062 (struct locate_file_in_directory_mapper_closure *) arg;
|
|
428
|
1063 struct stat st;
|
|
|
1064
|
|
|
1065 /* Ignore file if it's a directory. */
|
|
771
|
1066 if (qxe_stat (fn, &st) >= 0
|
|
428
|
1067 && (st.st_mode & S_IFMT) != S_IFDIR)
|
|
|
1068 {
|
|
|
1069 /* Check that we can access or open it. */
|
|
1123
|
1070 closure->fd = locate_file_open_or_access_file (fn, closure->mode);
|
|
428
|
1071
|
|
|
1072 if (closure->fd >= 0)
|
|
|
1073 {
|
|
2548
|
1074 if (!check_if_suppressed (fn, Qnil))
|
|
|
1075 {
|
|
|
1076 /* We succeeded; return this descriptor and filename. */
|
|
|
1077 if (closure->storeptr)
|
|
|
1078 *closure->storeptr = build_intstring (fn);
|
|
|
1079
|
|
|
1080 return 1;
|
|
|
1081 }
|
|
428
|
1082 }
|
|
|
1083 }
|
|
|
1084 /* Keep mapping. */
|
|
|
1085 return 0;
|
|
|
1086 }
|
|
|
1087
|
|
|
1088
|
|
|
1089 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
|
|
|
1090 not have been expanded. */
|
|
|
1091
|
|
|
1092 static int
|
|
|
1093 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
|
|
|
1094 Lisp_Object suffixes, Lisp_Object *storeptr,
|
|
|
1095 int mode)
|
|
|
1096 {
|
|
|
1097 /* This function can GC */
|
|
|
1098 struct locate_file_in_directory_mapper_closure closure;
|
|
|
1099 Lisp_Object filename = Qnil;
|
|
|
1100 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
1101
|
|
|
1102 GCPRO3 (directory, str, filename);
|
|
|
1103
|
|
|
1104 filename = Fexpand_file_name (str, directory);
|
|
|
1105 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
|
|
|
1106 /* If there are non-absolute elts in PATH (eg ".") */
|
|
|
1107 /* Of course, this could conceivably lose if luser sets
|
|
|
1108 default-directory to be something non-absolute ... */
|
|
|
1109 {
|
|
|
1110 if (NILP (filename))
|
|
|
1111 /* NIL means current directory */
|
|
|
1112 filename = current_buffer->directory;
|
|
|
1113 else
|
|
|
1114 filename = Fexpand_file_name (filename,
|
|
|
1115 current_buffer->directory);
|
|
|
1116 if (NILP (Ffile_name_absolute_p (filename)))
|
|
|
1117 {
|
|
|
1118 /* Give up on this directory! */
|
|
|
1119 UNGCPRO;
|
|
|
1120 return -1;
|
|
|
1121 }
|
|
|
1122 }
|
|
|
1123
|
|
|
1124 closure.fd = -1;
|
|
|
1125 closure.storeptr = storeptr;
|
|
|
1126 closure.mode = mode;
|
|
|
1127
|
|
771
|
1128 locate_file_map_suffixes (filename, suffixes,
|
|
|
1129 locate_file_in_directory_mapper,
|
|
428
|
1130 &closure);
|
|
|
1131
|
|
|
1132 UNGCPRO;
|
|
|
1133 return closure.fd;
|
|
|
1134 }
|
|
|
1135
|
|
|
1136 /* do the same as locate_file() but don't use any hash tables. */
|
|
|
1137
|
|
|
1138 static int
|
|
|
1139 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
|
|
|
1140 Lisp_Object suffixes, Lisp_Object *storeptr,
|
|
|
1141 int mode)
|
|
|
1142 {
|
|
|
1143 /* This function can GC */
|
|
|
1144 int absolute = !NILP (Ffile_name_absolute_p (str));
|
|
|
1145
|
|
2367
|
1146 EXTERNAL_LIST_LOOP_2 (elt, path)
|
|
428
|
1147 {
|
|
2367
|
1148 int val = locate_file_in_directory (elt, str, suffixes, storeptr,
|
|
428
|
1149 mode);
|
|
|
1150 if (val >= 0)
|
|
|
1151 return val;
|
|
|
1152 if (absolute)
|
|
|
1153 break;
|
|
|
1154 }
|
|
|
1155 return -1;
|
|
|
1156 }
|
|
|
1157
|
|
|
1158 static int
|
|
867
|
1159 locate_file_construct_suffixed_files_mapper (Ibyte *fn, void *arg)
|
|
428
|
1160 {
|
|
771
|
1161 Lisp_Object *tail = (Lisp_Object *) arg;
|
|
|
1162 *tail = Fcons (build_intstring (fn), *tail);
|
|
428
|
1163 return 0;
|
|
|
1164 }
|
|
|
1165
|
|
|
1166 /* Construct a list of all files to search for.
|
|
|
1167 It makes sense to have this despite locate_file_map_suffixes()
|
|
|
1168 because we need Lisp strings to access the hash-table, and it would
|
|
|
1169 be inefficient to create them on the fly, again and again for each
|
|
|
1170 path component. See locate_file(). */
|
|
|
1171
|
|
|
1172 static Lisp_Object
|
|
|
1173 locate_file_construct_suffixed_files (Lisp_Object filename,
|
|
|
1174 Lisp_Object suffixes)
|
|
|
1175 {
|
|
|
1176 Lisp_Object tail = Qnil;
|
|
|
1177 struct gcpro gcpro1;
|
|
|
1178 GCPRO1 (tail);
|
|
|
1179
|
|
|
1180 locate_file_map_suffixes (filename, suffixes,
|
|
|
1181 locate_file_construct_suffixed_files_mapper,
|
|
|
1182 &tail);
|
|
|
1183
|
|
|
1184 UNGCPRO;
|
|
|
1185 return Fnreverse (tail);
|
|
|
1186 }
|
|
|
1187
|
|
|
1188 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
|
|
|
1189 Clear the hash records for the specified list of directories.
|
|
|
1190 `locate-file' uses a hashing scheme to speed lookup, and will correctly
|
|
|
1191 track the following environmental changes:
|
|
|
1192
|
|
|
1193 -- changes of any sort to the list of directories to be searched.
|
|
|
1194 -- addition and deletion of non-shadowing files (see below) from the
|
|
|
1195 directories in the list.
|
|
|
1196 -- byte-compilation of a .el file into a .elc file.
|
|
|
1197
|
|
|
1198 `locate-file' will primarily get confused if you add a file that shadows
|
|
|
1199 \(i.e. has the same name as) another file further down in the directory list.
|
|
|
1200 In this case, you must call `locate-file-clear-hashing'.
|
|
|
1201
|
|
|
1202 If PATH is t, it means to fully clear all the accumulated hashes. This
|
|
|
1203 can be used if the internal tables grow too large, or when dumping.
|
|
|
1204 */
|
|
|
1205 (path))
|
|
|
1206 {
|
|
|
1207 if (EQ (path, Qt))
|
|
|
1208 Fclrhash (Vlocate_file_hash_table);
|
|
|
1209 else
|
|
|
1210 {
|
|
2367
|
1211 EXTERNAL_LIST_LOOP_2 (elt, path)
|
|
428
|
1212 {
|
|
2367
|
1213 Lisp_Object pathel = Fexpand_file_name (elt, Qnil);
|
|
428
|
1214 Fremhash (pathel, Vlocate_file_hash_table);
|
|
|
1215 }
|
|
|
1216 }
|
|
|
1217 return Qnil;
|
|
|
1218 }
|
|
|
1219
|
|
|
1220 /* Search for a file whose name is STR, looking in directories
|
|
|
1221 in the Lisp list PATH, and trying suffixes from SUFFIXES.
|
|
|
1222 SUFFIXES is a list of possible suffixes, or (for backward
|
|
|
1223 compatibility) a string containing possible suffixes separated by
|
|
|
1224 colons.
|
|
|
1225 On success, returns a file descriptor. On failure, returns -1.
|
|
|
1226
|
|
|
1227 MODE nonnegative means don't open the files,
|
|
|
1228 just look for one for which access(file,MODE) succeeds. In this case,
|
|
951
|
1229 returns a nonnegative value on success. On failure, returns -1.
|
|
428
|
1230
|
|
2548
|
1231 If STOREPTR is non-nil, it points to a slot where the name of
|
|
428
|
1232 the file actually found should be stored as a Lisp string.
|
|
|
1233 Nil is stored there on failure.
|
|
|
1234
|
|
|
1235 Called openp() in FSFmacs. */
|
|
|
1236
|
|
|
1237 int
|
|
|
1238 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
|
|
|
1239 Lisp_Object *storeptr, int mode)
|
|
|
1240 {
|
|
|
1241 /* This function can GC */
|
|
|
1242 Lisp_Object suffixtab = Qnil;
|
|
2367
|
1243 Lisp_Object pathel_expanded;
|
|
428
|
1244 int val;
|
|
|
1245 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
|
1246
|
|
|
1247 if (storeptr)
|
|
|
1248 *storeptr = Qnil;
|
|
|
1249
|
|
|
1250 /* Is it really necessary to gcpro path and str? It shouldn't be
|
|
|
1251 unless some caller has fucked up. There are known instances that
|
|
|
1252 call us with build_string("foo:bar") as SUFFIXES, though. */
|
|
|
1253 GCPRO4 (path, str, suffixes, suffixtab);
|
|
|
1254
|
|
|
1255 /* if this filename has directory components, it's too complicated
|
|
|
1256 to try and use the hash tables. */
|
|
|
1257 if (!NILP (Ffile_name_directory (str)))
|
|
|
1258 {
|
|
|
1259 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
|
|
|
1260 UNGCPRO;
|
|
|
1261 return val;
|
|
|
1262 }
|
|
|
1263
|
|
|
1264 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
|
|
|
1265
|
|
2367
|
1266 {
|
|
|
1267 EXTERNAL_LIST_LOOP_2 (pathel, path)
|
|
|
1268 {
|
|
|
1269 Lisp_Object hash_table;
|
|
|
1270 int found = 0;
|
|
|
1271
|
|
|
1272 /* If this path element is relative, we have to look by hand. */
|
|
|
1273 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
|
|
|
1274 {
|
|
|
1275 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
|
|
|
1276 mode);
|
|
|
1277 if (val >= 0)
|
|
428
|
1278 {
|
|
2367
|
1279 UNGCPRO;
|
|
|
1280 return val;
|
|
428
|
1281 }
|
|
2367
|
1282 continue;
|
|
|
1283 }
|
|
|
1284
|
|
|
1285 pathel_expanded = Fexpand_file_name (pathel, Qnil);
|
|
|
1286 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
|
|
|
1287
|
|
|
1288 if (!NILP (hash_table))
|
|
|
1289 {
|
|
|
1290 /* Loop over suffixes. */
|
|
|
1291 LIST_LOOP_2 (elt, suffixtab)
|
|
|
1292 if (!NILP (Fgethash (elt, hash_table, Qnil)))
|
|
|
1293 {
|
|
|
1294 found = 1;
|
|
|
1295 break;
|
|
|
1296 }
|
|
|
1297 }
|
|
|
1298
|
|
|
1299 if (found)
|
|
|
1300 {
|
|
|
1301 /* This is a likely candidate. Look by hand in this directory
|
|
|
1302 so we don't get thrown off if someone byte-compiles a file. */
|
|
|
1303 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
|
|
|
1304 mode);
|
|
|
1305 if (val >= 0)
|
|
|
1306 {
|
|
|
1307 UNGCPRO;
|
|
|
1308 return val;
|
|
|
1309 }
|
|
|
1310
|
|
|
1311 /* Hmm ... the file isn't actually there. (Or possibly it's
|
|
|
1312 a directory ...) So refresh our hashing. */
|
|
|
1313 locate_file_refresh_hashing (pathel_expanded);
|
|
|
1314 }
|
|
|
1315 }
|
|
428
|
1316 }
|
|
|
1317
|
|
|
1318 /* File is probably not there, but check the hard way just in case. */
|
|
|
1319 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
|
|
|
1320 if (val >= 0)
|
|
|
1321 {
|
|
|
1322 /* Sneaky user added a file without telling us. */
|
|
|
1323 Flocate_file_clear_hashing (path);
|
|
|
1324 }
|
|
|
1325
|
|
|
1326 UNGCPRO;
|
|
|
1327 return val;
|
|
|
1328 }
|
|
|
1329
|
|
|
1330
|
|
|
1331 #ifdef LOADHIST
|
|
|
1332
|
|
|
1333 /* Merge the list we've accumulated of globals from the current input source
|
|
|
1334 into the load_history variable. The details depend on whether
|
|
|
1335 the source has an associated file name or not. */
|
|
|
1336
|
|
|
1337 static void
|
|
|
1338 build_load_history (int loading, Lisp_Object source)
|
|
|
1339 {
|
|
|
1340 REGISTER Lisp_Object tail, prev, newelt;
|
|
|
1341 REGISTER Lisp_Object tem, tem2;
|
|
|
1342 int foundit;
|
|
|
1343
|
|
|
1344 #if !defined(LOADHIST_DUMPED)
|
|
|
1345 /* Don't bother recording anything for preloaded files. */
|
|
|
1346 if (purify_flag)
|
|
|
1347 return;
|
|
|
1348 #endif
|
|
|
1349
|
|
|
1350 tail = Vload_history;
|
|
|
1351 prev = Qnil;
|
|
|
1352 foundit = 0;
|
|
|
1353 while (!NILP (tail))
|
|
|
1354 {
|
|
|
1355 tem = Fcar (tail);
|
|
|
1356
|
|
|
1357 /* Find the feature's previous assoc list... */
|
|
|
1358 if (internal_equal (source, Fcar (tem), 0))
|
|
|
1359 {
|
|
|
1360 foundit = 1;
|
|
|
1361
|
|
|
1362 /* If we're loading, remove it. */
|
|
|
1363 if (loading)
|
|
|
1364 {
|
|
|
1365 if (NILP (prev))
|
|
|
1366 Vload_history = Fcdr (tail);
|
|
|
1367 else
|
|
|
1368 Fsetcdr (prev, Fcdr (tail));
|
|
|
1369 }
|
|
|
1370
|
|
|
1371 /* Otherwise, cons on new symbols that are not already members. */
|
|
|
1372 else
|
|
|
1373 {
|
|
|
1374 tem2 = Vcurrent_load_list;
|
|
|
1375
|
|
|
1376 while (CONSP (tem2))
|
|
|
1377 {
|
|
|
1378 newelt = XCAR (tem2);
|
|
|
1379
|
|
|
1380 if (NILP (Fmemq (newelt, tem)))
|
|
|
1381 Fsetcar (tail, Fcons (Fcar (tem),
|
|
|
1382 Fcons (newelt, Fcdr (tem))));
|
|
|
1383
|
|
|
1384 tem2 = XCDR (tem2);
|
|
|
1385 QUIT;
|
|
|
1386 }
|
|
|
1387 }
|
|
|
1388 }
|
|
|
1389 else
|
|
|
1390 prev = tail;
|
|
|
1391 tail = Fcdr (tail);
|
|
|
1392 QUIT;
|
|
|
1393 }
|
|
|
1394
|
|
|
1395 /* If we're loading, cons the new assoc onto the front of load-history,
|
|
|
1396 the most-recently-loaded position. Also do this if we didn't find
|
|
|
1397 an existing member for the current source. */
|
|
|
1398 if (loading || !foundit)
|
|
|
1399 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
|
|
|
1400 Vload_history);
|
|
|
1401 }
|
|
|
1402
|
|
|
1403 #else /* !LOADHIST */
|
|
|
1404 #define build_load_history(x,y)
|
|
|
1405 #endif /* !LOADHIST */
|
|
|
1406
|
|
|
1407
|
|
|
1408 static void
|
|
|
1409 readevalloop (Lisp_Object readcharfun,
|
|
|
1410 Lisp_Object sourcename,
|
|
|
1411 Lisp_Object (*evalfun) (Lisp_Object),
|
|
|
1412 int printflag)
|
|
|
1413 {
|
|
|
1414 /* This function can GC */
|
|
867
|
1415 REGISTER Ichar c;
|
|
1849
|
1416 Lisp_Object val = Qnil;
|
|
428
|
1417 int speccount = specpdl_depth ();
|
|
|
1418 struct gcpro gcpro1, gcpro2;
|
|
|
1419 struct buffer *b = 0;
|
|
|
1420
|
|
|
1421 if (BUFFERP (readcharfun))
|
|
|
1422 b = XBUFFER (readcharfun);
|
|
|
1423 else if (MARKERP (readcharfun))
|
|
|
1424 b = XMARKER (readcharfun)->buffer;
|
|
|
1425
|
|
|
1426 /* Don't do this. It is not necessary, and it needlessly exposes
|
|
|
1427 READCHARFUN (which can be a stream) to Lisp. --hniksic */
|
|
|
1428 /*specbind (Qstandard_input, readcharfun);*/
|
|
|
1429
|
|
2548
|
1430 internal_bind_lisp_object (&Vcurrent_load_list, Qnil);
|
|
428
|
1431
|
|
|
1432 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
1433 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
1434 #endif
|
|
|
1435 GCPRO2 (val, sourcename);
|
|
|
1436
|
|
|
1437 LOADHIST_ATTACH (sourcename);
|
|
|
1438
|
|
|
1439 while (1)
|
|
|
1440 {
|
|
|
1441 QUIT;
|
|
|
1442
|
|
|
1443 if (b != 0 && !BUFFER_LIVE_P (b))
|
|
563
|
1444 invalid_operation ("Reading from killed buffer", Qunbound);
|
|
428
|
1445
|
|
|
1446 c = readchar (readcharfun);
|
|
|
1447 if (c == ';')
|
|
|
1448 {
|
|
|
1449 /* Skip comment */
|
|
|
1450 while ((c = readchar (readcharfun)) != '\n' && c != -1)
|
|
|
1451 QUIT;
|
|
|
1452 continue;
|
|
|
1453 }
|
|
|
1454 if (c < 0)
|
|
|
1455 break;
|
|
|
1456
|
|
|
1457 /* Ignore whitespace here, so we can detect eof. */
|
|
|
1458 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
|
|
|
1459 continue;
|
|
|
1460
|
|
814
|
1461 unreadchar (readcharfun, c);
|
|
|
1462 Vread_objects = Qnil;
|
|
|
1463 if (NILP (Vload_read_function))
|
|
|
1464 val = read0 (readcharfun);
|
|
428
|
1465 else
|
|
814
|
1466 val = call1 (Vload_read_function, readcharfun);
|
|
428
|
1467 val = (*evalfun) (val);
|
|
|
1468 if (printflag)
|
|
|
1469 {
|
|
|
1470 Vvalues = Fcons (val, Vvalues);
|
|
|
1471 if (EQ (Vstandard_output, Qt))
|
|
|
1472 Fprin1 (val, Qnil);
|
|
|
1473 else
|
|
|
1474 Fprint (val, Qnil);
|
|
|
1475 }
|
|
|
1476 }
|
|
|
1477
|
|
|
1478 build_load_history (LSTREAMP (readcharfun) ||
|
|
|
1479 /* This looks weird, but it's what's in FSFmacs */
|
|
|
1480 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
|
|
|
1481 sourcename);
|
|
|
1482 UNGCPRO;
|
|
|
1483
|
|
771
|
1484 unbind_to (speccount);
|
|
428
|
1485 }
|
|
|
1486
|
|
|
1487 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
|
|
|
1488 Execute BUFFER as Lisp code.
|
|
|
1489 Programs can pass two arguments, BUFFER and PRINTFLAG.
|
|
|
1490 BUFFER is the buffer to evaluate (nil means use current buffer).
|
|
|
1491 PRINTFLAG controls printing of output:
|
|
444
|
1492 nil means discard it; anything else is a stream for printing.
|
|
428
|
1493
|
|
|
1494 If there is no error, point does not move. If there is an error,
|
|
|
1495 point remains at the end of the last character read from the buffer.
|
|
|
1496 */
|
|
444
|
1497 (buffer, printflag))
|
|
428
|
1498 {
|
|
|
1499 /* This function can GC */
|
|
|
1500 int speccount = specpdl_depth ();
|
|
|
1501 Lisp_Object tem, buf;
|
|
|
1502
|
|
444
|
1503 if (NILP (buffer))
|
|
428
|
1504 buf = Fcurrent_buffer ();
|
|
|
1505 else
|
|
444
|
1506 buf = Fget_buffer (buffer);
|
|
428
|
1507 if (NILP (buf))
|
|
563
|
1508 invalid_argument ("No such buffer", Qunbound);
|
|
428
|
1509
|
|
|
1510 if (NILP (printflag))
|
|
|
1511 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
|
|
|
1512 else
|
|
|
1513 tem = printflag;
|
|
|
1514 specbind (Qstandard_output, tem);
|
|
|
1515 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
|
|
1516 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
|
|
|
1517 readevalloop (buf, XBUFFER (buf)->filename, Feval,
|
|
|
1518 !NILP (printflag));
|
|
|
1519
|
|
771
|
1520 return unbind_to (speccount);
|
|
428
|
1521 }
|
|
|
1522
|
|
|
1523 #if 0
|
|
826
|
1524 DEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
|
|
428
|
1525 Execute the current buffer as Lisp code.
|
|
|
1526 Programs can pass argument PRINTFLAG which controls printing of output:
|
|
|
1527 nil means discard it; anything else is stream for print.
|
|
|
1528
|
|
|
1529 If there is no error, point does not move. If there is an error,
|
|
|
1530 point remains at the end of the last character read from the buffer.
|
|
|
1531 */
|
|
|
1532 (printflag))
|
|
|
1533 {
|
|
|
1534 code omitted;
|
|
|
1535 }
|
|
|
1536 #endif /* 0 */
|
|
|
1537
|
|
|
1538 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
|
|
|
1539 Execute the region as Lisp code.
|
|
444
|
1540 When called from programs, expects two arguments START and END
|
|
428
|
1541 giving starting and ending indices in the current buffer
|
|
|
1542 of the text to be executed.
|
|
444
|
1543 Programs can pass third optional argument STREAM which controls output:
|
|
428
|
1544 nil means discard it; anything else is stream for printing it.
|
|
|
1545
|
|
|
1546 If there is no error, point does not move. If there is an error,
|
|
|
1547 point remains at the end of the last character read from the buffer.
|
|
|
1548
|
|
|
1549 Note: Before evaling the region, this function narrows the buffer to it.
|
|
|
1550 If the code being eval'd should happen to trigger a redisplay you may
|
|
|
1551 see some text temporarily disappear because of this.
|
|
|
1552 */
|
|
444
|
1553 (start, end, stream))
|
|
428
|
1554 {
|
|
|
1555 /* This function can GC */
|
|
|
1556 int speccount = specpdl_depth ();
|
|
|
1557 Lisp_Object tem;
|
|
|
1558 Lisp_Object cbuf = Fcurrent_buffer ();
|
|
|
1559
|
|
444
|
1560 if (NILP (stream))
|
|
428
|
1561 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
|
|
|
1562 else
|
|
444
|
1563 tem = stream;
|
|
428
|
1564 specbind (Qstandard_output, tem);
|
|
|
1565
|
|
444
|
1566 if (NILP (stream))
|
|
428
|
1567 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
|
844
|
1568 record_unwind_protect (save_restriction_restore,
|
|
|
1569 save_restriction_save (current_buffer));
|
|
428
|
1570
|
|
444
|
1571 /* This both uses start and checks its type. */
|
|
|
1572 Fgoto_char (start, cbuf);
|
|
|
1573 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
|
|
428
|
1574 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
|
|
444
|
1575 !NILP (stream));
|
|
428
|
1576
|
|
771
|
1577 return unbind_to (speccount);
|
|
428
|
1578 }
|
|
|
1579
|
|
|
1580 DEFUN ("read", Fread, 0, 1, 0, /*
|
|
|
1581 Read one Lisp expression as text from STREAM, return as Lisp object.
|
|
|
1582 If STREAM is nil, use the value of `standard-input' (which see).
|
|
|
1583 STREAM or the value of `standard-input' may be:
|
|
|
1584 a buffer (read from point and advance it)
|
|
|
1585 a marker (read from where it points and advance it)
|
|
|
1586 a function (call it with no arguments for each character,
|
|
|
1587 call it with a char as argument to push a char back)
|
|
|
1588 a string (takes text from string, starting at the beginning)
|
|
|
1589 t (read text line using minibuffer and use it).
|
|
|
1590 */
|
|
|
1591 (stream))
|
|
|
1592 {
|
|
|
1593 if (NILP (stream))
|
|
|
1594 stream = Vstandard_input;
|
|
|
1595 if (EQ (stream, Qt))
|
|
|
1596 stream = Qread_char;
|
|
|
1597
|
|
|
1598 Vread_objects = Qnil;
|
|
|
1599
|
|
|
1600 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
1601 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
1602 #endif
|
|
|
1603 if (EQ (stream, Qread_char))
|
|
|
1604 {
|
|
|
1605 Lisp_Object val = call1 (Qread_from_minibuffer,
|
|
771
|
1606 build_msg_string ("Lisp expression: "));
|
|
428
|
1607 return Fcar (Fread_from_string (val, Qnil, Qnil));
|
|
|
1608 }
|
|
|
1609
|
|
|
1610 if (STRINGP (stream))
|
|
|
1611 return Fcar (Fread_from_string (stream, Qnil, Qnil));
|
|
|
1612
|
|
|
1613 return read0 (stream);
|
|
|
1614 }
|
|
|
1615
|
|
|
1616 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
|
|
|
1617 Read one Lisp expression which is represented as text by STRING.
|
|
|
1618 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
|
|
|
1619 START and END optionally delimit a substring of STRING from which to read;
|
|
|
1620 they default to 0 and (length STRING) respectively.
|
|
|
1621 */
|
|
|
1622 (string, start, end))
|
|
|
1623 {
|
|
|
1624 Bytecount startval, endval;
|
|
|
1625 Lisp_Object tem;
|
|
|
1626 Lisp_Object lispstream = Qnil;
|
|
|
1627 struct gcpro gcpro1;
|
|
|
1628
|
|
|
1629 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
1630 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
1631 #endif
|
|
|
1632 GCPRO1 (lispstream);
|
|
|
1633 CHECK_STRING (string);
|
|
|
1634 get_string_range_byte (string, start, end, &startval, &endval,
|
|
|
1635 GB_HISTORICAL_STRING_BEHAVIOR);
|
|
|
1636 lispstream = make_lisp_string_input_stream (string, startval,
|
|
|
1637 endval - startval);
|
|
|
1638
|
|
|
1639 Vread_objects = Qnil;
|
|
|
1640
|
|
|
1641 tem = read0 (lispstream);
|
|
|
1642 /* Yeah, it's ugly. Gonna make something of it?
|
|
|
1643 At least our reader is reentrant ... */
|
|
|
1644 tem =
|
|
|
1645 (Fcons (tem, make_int
|
|
793
|
1646 (string_index_byte_to_char
|
|
771
|
1647 (string,
|
|
428
|
1648 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
|
|
|
1649 Lstream_delete (XLSTREAM (lispstream));
|
|
|
1650 UNGCPRO;
|
|
|
1651 return tem;
|
|
|
1652 }
|
|
|
1653
|
|
|
1654
|
|
|
1655
|
|
|
1656 /* Use this for recursive reads, in contexts where internal tokens
|
|
|
1657 are not allowed. See also read1(). */
|
|
|
1658 static Lisp_Object
|
|
|
1659 read0 (Lisp_Object readcharfun)
|
|
|
1660 {
|
|
|
1661 Lisp_Object val = read1 (readcharfun);
|
|
|
1662
|
|
|
1663 if (CONSP (val) && UNBOUNDP (XCAR (val)))
|
|
|
1664 {
|
|
867
|
1665 Ichar c = XCHAR (XCDR (val));
|
|
853
|
1666 free_cons (val);
|
|
428
|
1667 return Fsignal (Qinvalid_read_syntax,
|
|
|
1668 list1 (Fchar_to_string (make_char (c))));
|
|
|
1669 }
|
|
|
1670
|
|
|
1671 return val;
|
|
|
1672 }
|
|
3543
|
1673
|
|
|
1674 /* A Unicode escape, as in C# (though we only permit them in strings
|
|
|
1675 and characters, not arbitrarily in the source code.) */
|
|
|
1676 static Ichar
|
|
|
1677 read_unicode_escape (Lisp_Object readcharfun, int unicode_hex_count)
|
|
|
1678 {
|
|
|
1679 REGISTER Ichar i = 0, c;
|
|
|
1680 REGISTER int count = 0;
|
|
|
1681 Lisp_Object lisp_char;
|
|
|
1682 while (++count <= unicode_hex_count)
|
|
|
1683 {
|
|
|
1684 c = readchar (readcharfun);
|
|
|
1685 /* Remember, can't use isdigit(), isalpha() etc. on Ichars */
|
|
|
1686 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
|
|
|
1687 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
|
|
|
1688 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
|
|
|
1689 else
|
|
|
1690 {
|
|
|
1691 syntax_error ("Non-hex digit used for Unicode escape",
|
|
|
1692 make_char (c));
|
|
|
1693 break;
|
|
|
1694 }
|
|
|
1695 }
|
|
|
1696
|
|
|
1697 lisp_char = Funicode_to_char(make_int(i), Qnil);
|
|
|
1698
|
|
|
1699 if (EQ(Qnil, lisp_char))
|
|
|
1700 {
|
|
|
1701 /* This is ugly and horrible and trashes the user's data, but
|
|
|
1702 it's what unicode.c does. In the future, unicode-to-char
|
|
|
1703 should not return nil. */
|
|
|
1704 #ifdef MULE
|
|
|
1705 i = make_ichar (Vcharset_japanese_jisx0208, 34 + 128, 46 + 128);
|
|
|
1706 #else
|
|
|
1707 i = '~';
|
|
|
1708 #endif
|
|
|
1709 return i;
|
|
|
1710 }
|
|
|
1711 else
|
|
|
1712 {
|
|
|
1713 return XCHAR(lisp_char);
|
|
|
1714 }
|
|
|
1715 }
|
|
|
1716
|
|
428
|
1717
|
|
867
|
1718 static Ichar
|
|
428
|
1719 read_escape (Lisp_Object readcharfun)
|
|
|
1720 {
|
|
|
1721 /* This function can GC */
|
|
867
|
1722 Ichar c = readchar (readcharfun);
|
|
428
|
1723
|
|
|
1724 if (c < 0)
|
|
563
|
1725 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
1726
|
|
|
1727 switch (c)
|
|
|
1728 {
|
|
|
1729 case 'a': return '\007';
|
|
|
1730 case 'b': return '\b';
|
|
|
1731 case 'd': return 0177;
|
|
|
1732 case 'e': return 033;
|
|
|
1733 case 'f': return '\f';
|
|
|
1734 case 'n': return '\n';
|
|
|
1735 case 'r': return '\r';
|
|
|
1736 case 't': return '\t';
|
|
|
1737 case 'v': return '\v';
|
|
|
1738 case '\n': return -1;
|
|
|
1739
|
|
|
1740 case 'M':
|
|
|
1741 c = readchar (readcharfun);
|
|
|
1742 if (c < 0)
|
|
563
|
1743 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
1744 if (c != '-')
|
|
563
|
1745 syntax_error ("Invalid escape character syntax", Qunbound);
|
|
428
|
1746 c = readchar (readcharfun);
|
|
|
1747 if (c < 0)
|
|
563
|
1748 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
1749 if (c == '\\')
|
|
|
1750 c = read_escape (readcharfun);
|
|
|
1751 return c | 0200;
|
|
|
1752
|
|
|
1753 /* Originally, FSF_KEYS provided a degree of FSF Emacs
|
|
|
1754 compatibility by defining character "modifiers" alt, super,
|
|
|
1755 hyper and shift to infest the characters (i.e. integers).
|
|
|
1756
|
|
|
1757 However, this doesn't cut it for XEmacs 20, which
|
|
|
1758 distinguishes characters from integers. Without Mule, ?\H-a
|
|
|
1759 simply returns ?a because every character is clipped into
|
|
|
1760 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
|
|
|
1761 produces an illegal character, and moves us to crash-land.
|
|
|
1762
|
|
|
1763 For these reasons, FSF_KEYS hack is useless and without hope
|
|
|
1764 of ever working under XEmacs 20. */
|
|
|
1765 #ifdef FSF_KEYS
|
|
831
|
1766 /* Deleted */
|
|
|
1767 #endif
|
|
428
|
1768
|
|
|
1769 case 'C':
|
|
|
1770 c = readchar (readcharfun);
|
|
|
1771 if (c < 0)
|
|
563
|
1772 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
1773 if (c != '-')
|
|
563
|
1774 syntax_error ("Invalid escape character syntax", Qunbound);
|
|
428
|
1775 case '^':
|
|
|
1776 c = readchar (readcharfun);
|
|
|
1777 if (c < 0)
|
|
563
|
1778 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
1779 if (c == '\\')
|
|
|
1780 c = read_escape (readcharfun);
|
|
|
1781 /* FSFmacs junk for non-ASCII controls.
|
|
|
1782 Not used here. */
|
|
|
1783 if (c == '?')
|
|
|
1784 return 0177;
|
|
|
1785 else
|
|
|
1786 return c & (0200 | 037);
|
|
|
1787
|
|
|
1788 case '0':
|
|
|
1789 case '1':
|
|
|
1790 case '2':
|
|
|
1791 case '3':
|
|
|
1792 case '4':
|
|
|
1793 case '5':
|
|
|
1794 case '6':
|
|
|
1795 case '7':
|
|
|
1796 /* An octal escape, as in ANSI C. */
|
|
|
1797 {
|
|
867
|
1798 REGISTER Ichar i = c - '0';
|
|
428
|
1799 REGISTER int count = 0;
|
|
|
1800 while (++count < 3)
|
|
|
1801 {
|
|
|
1802 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
|
|
|
1803 i = (i << 3) + (c - '0');
|
|
|
1804 else
|
|
|
1805 {
|
|
|
1806 unreadchar (readcharfun, c);
|
|
|
1807 break;
|
|
|
1808 }
|
|
|
1809 }
|
|
831
|
1810 if (i >= 0400)
|
|
3367
|
1811 syntax_error ("Non-ISO-8859-1 character specified with octal escape",
|
|
831
|
1812 make_int (i));
|
|
428
|
1813 return i;
|
|
|
1814 }
|
|
|
1815
|
|
|
1816 case 'x':
|
|
|
1817 /* A hex escape, as in ANSI C, except that we only allow latin-1
|
|
|
1818 characters to be read this way. What is "\x4e03" supposed to
|
|
|
1819 mean, anyways, if the internal representation is hidden?
|
|
|
1820 This is also consistent with the treatment of octal escapes. */
|
|
|
1821 {
|
|
867
|
1822 REGISTER Ichar i = 0;
|
|
428
|
1823 REGISTER int count = 0;
|
|
|
1824 while (++count <= 2)
|
|
|
1825 {
|
|
|
1826 c = readchar (readcharfun);
|
|
867
|
1827 /* Remember, can't use isdigit(), isalpha() etc. on Ichars */
|
|
428
|
1828 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
|
|
|
1829 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
|
|
|
1830 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
|
|
|
1831 else
|
|
|
1832 {
|
|
|
1833 unreadchar (readcharfun, c);
|
|
|
1834 break;
|
|
|
1835 }
|
|
|
1836 }
|
|
|
1837 return i;
|
|
|
1838 }
|
|
3367
|
1839 case 'U':
|
|
|
1840 /* Post-Unicode-2.0: Up to eight hex chars */
|
|
3543
|
1841 return read_unicode_escape(readcharfun, 8);
|
|
3367
|
1842 case 'u':
|
|
3543
|
1843 /* Unicode-2.0 and before; four hex chars. */
|
|
|
1844 return read_unicode_escape(readcharfun, 4);
|
|
428
|
1845
|
|
|
1846 default:
|
|
|
1847 return c;
|
|
|
1848 }
|
|
|
1849 }
|
|
|
1850
|
|
|
1851
|
|
|
1852
|
|
|
1853 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
|
|
|
1854 static Bytecount
|
|
867
|
1855 read_atom_0 (Lisp_Object readcharfun, Ichar firstchar, int *saw_a_backslash)
|
|
428
|
1856 {
|
|
|
1857 /* This function can GC */
|
|
867
|
1858 Ichar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
|
|
428
|
1859 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
|
|
|
1860
|
|
|
1861 *saw_a_backslash = 0;
|
|
|
1862
|
|
|
1863 while (c > 040 /* #### - comma should be here as should backquote */
|
|
|
1864 && !(c == '\"' || c == '\'' || c == ';'
|
|
|
1865 || c == '(' || c == ')'
|
|
|
1866 || c == '[' || c == ']' || c == '#'
|
|
|
1867 ))
|
|
|
1868 {
|
|
|
1869 if (c == '\\')
|
|
|
1870 {
|
|
|
1871 c = readchar (readcharfun);
|
|
|
1872 if (c < 0)
|
|
563
|
1873 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
1874 *saw_a_backslash = 1;
|
|
|
1875 }
|
|
867
|
1876 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), c);
|
|
428
|
1877 QUIT;
|
|
|
1878 c = readchar (readcharfun);
|
|
|
1879 }
|
|
|
1880
|
|
|
1881 if (c >= 0)
|
|
|
1882 unreadchar (readcharfun, c);
|
|
|
1883 /* blasted terminating 0 */
|
|
867
|
1884 Lstream_put_ichar (XLSTREAM (Vread_buffer_stream), 0);
|
|
428
|
1885 Lstream_flush (XLSTREAM (Vread_buffer_stream));
|
|
|
1886
|
|
|
1887 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
|
|
|
1888 }
|
|
|
1889
|
|
867
|
1890 static Lisp_Object parse_integer (const Ibyte *buf, Bytecount len, int base);
|
|
428
|
1891
|
|
|
1892 static Lisp_Object
|
|
|
1893 read_atom (Lisp_Object readcharfun,
|
|
867
|
1894 Ichar firstchar,
|
|
428
|
1895 int uninterned_symbol)
|
|
|
1896 {
|
|
|
1897 /* This function can GC */
|
|
|
1898 int saw_a_backslash;
|
|
|
1899 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
|
|
|
1900 char *read_ptr = (char *)
|
|
|
1901 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
|
|
|
1902
|
|
|
1903 /* Is it an integer? */
|
|
|
1904 if (! (saw_a_backslash || uninterned_symbol))
|
|
|
1905 {
|
|
|
1906 /* If a token had any backslashes in it, it is disqualified from
|
|
|
1907 being an integer or a float. This means that 123\456 is a
|
|
|
1908 symbol, as is \123 (which is the way (intern "123") prints).
|
|
|
1909 Also, if token was preceded by #:, it's always a symbol.
|
|
|
1910 */
|
|
|
1911 char *p = read_ptr + len;
|
|
|
1912 char *p1 = read_ptr;
|
|
|
1913
|
|
|
1914 if (*p1 == '+' || *p1 == '-') p1++;
|
|
|
1915 if (p1 != p)
|
|
|
1916 {
|
|
|
1917 int c;
|
|
|
1918
|
|
|
1919 while (p1 != p && (c = *p1) >= '0' && c <= '9')
|
|
|
1920 p1++;
|
|
|
1921 /* Integers can have trailing decimal points. */
|
|
|
1922 if (p1 > read_ptr && p1 < p && *p1 == '.')
|
|
|
1923 p1++;
|
|
|
1924 if (p1 == p)
|
|
|
1925 {
|
|
|
1926 /* It is an integer. */
|
|
|
1927 if (p1[-1] == '.')
|
|
|
1928 p1[-1] = '\0';
|
|
|
1929 #if 0
|
|
|
1930 {
|
|
|
1931 int number = 0;
|
|
|
1932 if (sizeof (int) == sizeof (EMACS_INT))
|
|
|
1933 number = atoi (read_buffer);
|
|
|
1934 else if (sizeof (long) == sizeof (EMACS_INT))
|
|
|
1935 number = atol (read_buffer);
|
|
|
1936 else
|
|
2500
|
1937 ABORT ();
|
|
428
|
1938 return make_int (number);
|
|
|
1939 }
|
|
|
1940 #else
|
|
867
|
1941 return parse_integer ((Ibyte *) read_ptr, len, 10);
|
|
428
|
1942 #endif
|
|
|
1943 }
|
|
|
1944 }
|
|
1983
|
1945 #ifdef HAVE_RATIO
|
|
|
1946 if (isratio_string (read_ptr))
|
|
|
1947 {
|
|
2013
|
1948 /* GMP ratio_set_string has no effect with initial + sign */
|
|
2010
|
1949 if (*read_ptr == '+')
|
|
|
1950 read_ptr++;
|
|
1983
|
1951 ratio_set_string (scratch_ratio, read_ptr, 0);
|
|
|
1952 ratio_canonicalize (scratch_ratio);
|
|
|
1953 return Fcanonicalize_number (make_ratio_rt (scratch_ratio));
|
|
|
1954 }
|
|
|
1955 #endif
|
|
428
|
1956 if (isfloat_string (read_ptr))
|
|
|
1957 return make_float (atof (read_ptr));
|
|
|
1958 }
|
|
|
1959
|
|
|
1960 {
|
|
|
1961 Lisp_Object sym;
|
|
|
1962 if (uninterned_symbol)
|
|
867
|
1963 sym = Fmake_symbol ( make_string ((Ibyte *) read_ptr, len));
|
|
428
|
1964 else
|
|
|
1965 {
|
|
867
|
1966 Lisp_Object name = make_string ((Ibyte *) read_ptr, len);
|
|
428
|
1967 sym = Fintern (name, Qnil);
|
|
|
1968 }
|
|
|
1969 return sym;
|
|
|
1970 }
|
|
|
1971 }
|
|
|
1972
|
|
|
1973
|
|
|
1974 static Lisp_Object
|
|
867
|
1975 parse_integer (const Ibyte *buf, Bytecount len, int base)
|
|
428
|
1976 {
|
|
867
|
1977 const Ibyte *lim = buf + len;
|
|
|
1978 const Ibyte *p = buf;
|
|
428
|
1979 EMACS_UINT num = 0;
|
|
|
1980 int negativland = 0;
|
|
|
1981
|
|
|
1982 if (*p == '-')
|
|
|
1983 {
|
|
|
1984 negativland = 1;
|
|
|
1985 p++;
|
|
|
1986 }
|
|
|
1987 else if (*p == '+')
|
|
|
1988 {
|
|
|
1989 p++;
|
|
|
1990 }
|
|
|
1991
|
|
|
1992 if (p == lim)
|
|
|
1993 goto loser;
|
|
|
1994
|
|
|
1995 for (; (p < lim) && (*p != '\0'); p++)
|
|
|
1996 {
|
|
|
1997 int c = *p;
|
|
|
1998 EMACS_UINT onum;
|
|
|
1999
|
|
|
2000 if (isdigit (c))
|
|
|
2001 c = c - '0';
|
|
|
2002 else if (isupper (c))
|
|
|
2003 c = c - 'A' + 10;
|
|
|
2004 else if (islower (c))
|
|
|
2005 c = c - 'a' + 10;
|
|
|
2006 else
|
|
|
2007 goto loser;
|
|
|
2008
|
|
|
2009 if (c < 0 || c >= base)
|
|
|
2010 goto loser;
|
|
|
2011
|
|
|
2012 onum = num;
|
|
|
2013 num = num * base + c;
|
|
|
2014 if (num < onum)
|
|
|
2015 goto overflow;
|
|
|
2016 }
|
|
|
2017
|
|
|
2018 {
|
|
|
2019 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
|
|
|
2020 Lisp_Object result = make_int (int_result);
|
|
|
2021 if (num && ((XINT (result) < 0) != negativland))
|
|
|
2022 goto overflow;
|
|
|
2023 if (XINT (result) != int_result)
|
|
|
2024 goto overflow;
|
|
|
2025 return result;
|
|
|
2026 }
|
|
|
2027 overflow:
|
|
1983
|
2028 #ifdef HAVE_BIGNUM
|
|
|
2029 {
|
|
1995
|
2030 bignum_set_string (scratch_bignum, (const char *) buf, 0);
|
|
1983
|
2031 return make_bignum_bg (scratch_bignum);
|
|
|
2032 }
|
|
|
2033 #else
|
|
428
|
2034 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2035 list3 (build_msg_string
|
|
428
|
2036 ("Integer constant overflow in reader"),
|
|
|
2037 make_string (buf, len),
|
|
|
2038 make_int (base)));
|
|
1983
|
2039 #endif /* HAVE_BIGNUM */
|
|
428
|
2040 loser:
|
|
|
2041 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2042 list3 (build_msg_string
|
|
428
|
2043 ("Invalid integer constant in reader"),
|
|
|
2044 make_string (buf, len),
|
|
|
2045 make_int (base)));
|
|
|
2046 }
|
|
|
2047
|
|
|
2048
|
|
|
2049 static Lisp_Object
|
|
|
2050 read_integer (Lisp_Object readcharfun, int base)
|
|
|
2051 {
|
|
|
2052 /* This function can GC */
|
|
|
2053 int saw_a_backslash;
|
|
|
2054 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
|
|
|
2055 return (parse_integer
|
|
|
2056 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
|
|
|
2057 ((saw_a_backslash)
|
|
|
2058 ? 0 /* make parse_integer signal error */
|
|
|
2059 : len),
|
|
|
2060 base));
|
|
|
2061 }
|
|
|
2062
|
|
|
2063 static Lisp_Object
|
|
|
2064 read_bit_vector (Lisp_Object readcharfun)
|
|
|
2065 {
|
|
|
2066 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
|
|
440
|
2067 Lisp_Object val;
|
|
428
|
2068
|
|
|
2069 while (1)
|
|
|
2070 {
|
|
444
|
2071 unsigned char bit;
|
|
867
|
2072 Ichar c = readchar (readcharfun);
|
|
444
|
2073 if (c == '0')
|
|
|
2074 bit = 0;
|
|
|
2075 else if (c == '1')
|
|
|
2076 bit = 1;
|
|
|
2077 else
|
|
|
2078 {
|
|
|
2079 if (c >= 0)
|
|
|
2080 unreadchar (readcharfun, c);
|
|
|
2081 break;
|
|
|
2082 }
|
|
|
2083 Dynarr_add (dyn, bit);
|
|
428
|
2084 }
|
|
|
2085
|
|
440
|
2086 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
|
|
|
2087 Dynarr_length (dyn));
|
|
|
2088 Dynarr_free (dyn);
|
|
|
2089
|
|
|
2090 return val;
|
|
428
|
2091 }
|
|
|
2092
|
|
|
2093
|
|
|
2094
|
|
|
2095 /* structures */
|
|
|
2096
|
|
|
2097 struct structure_type *
|
|
|
2098 define_structure_type (Lisp_Object type,
|
|
|
2099 int (*validate) (Lisp_Object data,
|
|
578
|
2100 Error_Behavior errb),
|
|
428
|
2101 Lisp_Object (*instantiate) (Lisp_Object data))
|
|
|
2102 {
|
|
|
2103 struct structure_type st;
|
|
|
2104
|
|
|
2105 st.type = type;
|
|
|
2106 st.keywords = Dynarr_new (structure_keyword_entry);
|
|
|
2107 st.validate = validate;
|
|
|
2108 st.instantiate = instantiate;
|
|
|
2109 Dynarr_add (the_structure_type_dynarr, st);
|
|
|
2110
|
|
|
2111 return Dynarr_atp (the_structure_type_dynarr,
|
|
|
2112 Dynarr_length (the_structure_type_dynarr) - 1);
|
|
|
2113 }
|
|
|
2114
|
|
|
2115 void
|
|
|
2116 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
|
|
|
2117 int (*validate) (Lisp_Object keyword,
|
|
|
2118 Lisp_Object value,
|
|
578
|
2119 Error_Behavior errb))
|
|
428
|
2120 {
|
|
|
2121 struct structure_keyword_entry en;
|
|
|
2122
|
|
|
2123 en.keyword = keyword;
|
|
|
2124 en.validate = validate;
|
|
|
2125 Dynarr_add (st->keywords, en);
|
|
|
2126 }
|
|
|
2127
|
|
|
2128 static struct structure_type *
|
|
|
2129 recognized_structure_type (Lisp_Object type)
|
|
|
2130 {
|
|
|
2131 int i;
|
|
|
2132
|
|
|
2133 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
|
|
|
2134 {
|
|
|
2135 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
|
|
|
2136 if (EQ (st->type, type))
|
|
|
2137 return st;
|
|
|
2138 }
|
|
|
2139
|
|
|
2140 return 0;
|
|
|
2141 }
|
|
|
2142
|
|
|
2143 static Lisp_Object
|
|
|
2144 read_structure (Lisp_Object readcharfun)
|
|
|
2145 {
|
|
867
|
2146 Ichar c = readchar (readcharfun);
|
|
428
|
2147 Lisp_Object list = Qnil;
|
|
|
2148 Lisp_Object orig_list = Qnil;
|
|
|
2149 Lisp_Object already_seen = Qnil;
|
|
|
2150 int keyword_count;
|
|
|
2151 struct structure_type *st;
|
|
|
2152 struct gcpro gcpro1, gcpro2;
|
|
|
2153
|
|
|
2154 GCPRO2 (orig_list, already_seen);
|
|
|
2155 if (c != '(')
|
|
442
|
2156 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
|
|
428
|
2157 list = read_list (readcharfun, ')', 0, 0);
|
|
|
2158 orig_list = list;
|
|
|
2159 {
|
|
|
2160 int len = XINT (Flength (list));
|
|
|
2161 if (len == 0)
|
|
442
|
2162 RETURN_UNGCPRO (continuable_read_syntax_error
|
|
428
|
2163 ("structure type not specified"));
|
|
|
2164 if (!(len & 1))
|
|
|
2165 RETURN_UNGCPRO
|
|
442
|
2166 (continuable_read_syntax_error
|
|
428
|
2167 ("structures must have alternating keyword/value pairs"));
|
|
|
2168 }
|
|
|
2169
|
|
|
2170 st = recognized_structure_type (XCAR (list));
|
|
|
2171 if (!st)
|
|
|
2172 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
771
|
2173 list2 (build_msg_string
|
|
428
|
2174 ("unrecognized structure type"),
|
|
|
2175 XCAR (list))));
|
|
|
2176
|
|
|
2177 list = Fcdr (list);
|
|
|
2178 keyword_count = Dynarr_length (st->keywords);
|
|
|
2179 while (!NILP (list))
|
|
|
2180 {
|
|
|
2181 Lisp_Object keyword, value;
|
|
|
2182 int i;
|
|
|
2183 struct structure_keyword_entry *en = NULL;
|
|
|
2184
|
|
|
2185 keyword = Fcar (list);
|
|
|
2186 list = Fcdr (list);
|
|
|
2187 value = Fcar (list);
|
|
|
2188 list = Fcdr (list);
|
|
|
2189
|
|
|
2190 if (!NILP (memq_no_quit (keyword, already_seen)))
|
|
|
2191 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
771
|
2192 list2 (build_msg_string
|
|
428
|
2193 ("structure keyword already seen"),
|
|
|
2194 keyword)));
|
|
|
2195
|
|
|
2196 for (i = 0; i < keyword_count; i++)
|
|
|
2197 {
|
|
|
2198 en = Dynarr_atp (st->keywords, i);
|
|
|
2199 if (EQ (keyword, en->keyword))
|
|
|
2200 break;
|
|
|
2201 }
|
|
|
2202
|
|
|
2203 if (i == keyword_count)
|
|
|
2204 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
771
|
2205 list2 (build_msg_string
|
|
428
|
2206 ("unrecognized structure keyword"),
|
|
|
2207 keyword)));
|
|
|
2208
|
|
|
2209 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
|
|
|
2210 RETURN_UNGCPRO
|
|
|
2211 (Fsignal (Qinvalid_read_syntax,
|
|
771
|
2212 list3 (build_msg_string
|
|
428
|
2213 ("invalid value for structure keyword"),
|
|
|
2214 keyword, value)));
|
|
|
2215
|
|
|
2216 already_seen = Fcons (keyword, already_seen);
|
|
|
2217 }
|
|
|
2218
|
|
|
2219 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
|
|
|
2220 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
771
|
2221 list2 (build_msg_string
|
|
428
|
2222 ("invalid structure initializer"),
|
|
|
2223 orig_list)));
|
|
|
2224
|
|
|
2225 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
|
|
|
2226 }
|
|
|
2227
|
|
|
2228
|
|
|
2229 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
|
|
|
2230 int terminator);
|
|
|
2231 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
|
|
|
2232
|
|
|
2233 /* Get the next character; filter out whitespace and comments */
|
|
|
2234
|
|
867
|
2235 static Ichar
|
|
428
|
2236 reader_nextchar (Lisp_Object readcharfun)
|
|
|
2237 {
|
|
|
2238 /* This function can GC */
|
|
867
|
2239 Ichar c;
|
|
428
|
2240
|
|
|
2241 retry:
|
|
|
2242 QUIT;
|
|
|
2243 c = readchar (readcharfun);
|
|
|
2244 if (c < 0)
|
|
563
|
2245 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
|
|
428
|
2246
|
|
|
2247 switch (c)
|
|
|
2248 {
|
|
|
2249 default:
|
|
|
2250 {
|
|
|
2251 /* Ignore whitespace and control characters */
|
|
|
2252 if (c <= 040)
|
|
|
2253 goto retry;
|
|
|
2254 return c;
|
|
|
2255 }
|
|
|
2256
|
|
|
2257 case ';':
|
|
|
2258 {
|
|
|
2259 /* Comment */
|
|
|
2260 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
|
|
|
2261 QUIT;
|
|
|
2262 goto retry;
|
|
|
2263 }
|
|
|
2264 }
|
|
|
2265 }
|
|
|
2266
|
|
|
2267 #if 0
|
|
|
2268 static Lisp_Object
|
|
|
2269 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
|
|
|
2270 {
|
|
|
2271 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
|
|
|
2272 }
|
|
|
2273 #endif
|
|
|
2274
|
|
3543
|
2275 static Lisp_Object
|
|
|
2276 read_string (Lisp_Object readcharfun, Ichar delim, int raw,
|
|
|
2277 int honor_unicode)
|
|
|
2278 {
|
|
|
2279 #ifdef I18N3
|
|
|
2280 /* #### If the input stream is translating, then the string
|
|
|
2281 should be marked as translatable by setting its
|
|
|
2282 `string-translatable' property to t. .el and .elc files
|
|
|
2283 normally are translating input streams. See Fgettext()
|
|
|
2284 and print_internal(). */
|
|
|
2285 #endif
|
|
|
2286 Ichar c;
|
|
|
2287 int cancel = 0;
|
|
|
2288
|
|
|
2289 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
|
|
|
2290 while ((c = readchar(readcharfun)) >= 0 && c != delim)
|
|
|
2291 {
|
|
|
2292 if (c == '\\')
|
|
|
2293 {
|
|
|
2294 if (raw)
|
|
|
2295 {
|
|
|
2296 c = readchar(readcharfun);
|
|
|
2297 if (honor_unicode && ('u' == c || 'U' == c))
|
|
|
2298 {
|
|
|
2299 c = read_unicode_escape(readcharfun,
|
|
|
2300 'U' == c ? 8 : 4);
|
|
|
2301 }
|
|
|
2302 else
|
|
|
2303 {
|
|
|
2304 /* For raw strings, insert the
|
|
|
2305 backslash and the next char, */
|
|
|
2306 Lstream_put_ichar(XLSTREAM
|
|
|
2307 (Vread_buffer_stream),
|
|
|
2308 '\\');
|
|
|
2309 }
|
|
|
2310 }
|
|
|
2311 else
|
|
|
2312 /* otherwise, backslash escapes the next char. */
|
|
|
2313 c = read_escape(readcharfun);
|
|
|
2314 }
|
|
|
2315 /* c is -1 if \ newline has just been seen */
|
|
|
2316 if (c == -1)
|
|
|
2317 {
|
|
|
2318 if (Lstream_byte_count
|
|
|
2319 (XLSTREAM(Vread_buffer_stream)) ==
|
|
|
2320 0)
|
|
|
2321 cancel = 1;
|
|
|
2322 }
|
|
|
2323 else
|
|
|
2324 Lstream_put_ichar(XLSTREAM
|
|
|
2325 (Vread_buffer_stream),
|
|
|
2326 c);
|
|
|
2327 QUIT;
|
|
|
2328 }
|
|
|
2329 if (c < 0)
|
|
|
2330 return Fsignal(Qend_of_file,
|
|
|
2331 list1(READCHARFUN_MAYBE(readcharfun)));
|
|
|
2332
|
|
|
2333 /* If purifying, and string starts with \ newline,
|
|
|
2334 return zero instead. This is for doc strings
|
|
|
2335 that we are really going to find in lib-src/DOC.nn.nn */
|
|
|
2336 if (purify_flag && NILP(Vinternal_doc_file_name)
|
|
|
2337 && cancel)
|
|
|
2338 return Qzero;
|
|
|
2339
|
|
|
2340 Lstream_flush(XLSTREAM(Vread_buffer_stream));
|
|
|
2341 return make_string(resizing_buffer_stream_ptr
|
|
|
2342 (XLSTREAM(Vread_buffer_stream)),
|
|
|
2343 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
|
|
|
2344 }
|
|
|
2345
|
|
|
2346 static Lisp_Object
|
|
|
2347 read_raw_string (Lisp_Object readcharfun)
|
|
|
2348 {
|
|
|
2349 Ichar c;
|
|
|
2350 Ichar permit_unicode = 0;
|
|
|
2351
|
|
|
2352 do {
|
|
|
2353 c = reader_nextchar(readcharfun);
|
|
|
2354 switch (c) {
|
|
|
2355 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
|
|
|
2356 /* case ':': */
|
|
|
2357 /* #ru"Hi there\u20AC \U000020AC" -- raw string, honouring Unicode. */
|
|
|
2358 case 'u':
|
|
|
2359 case 'U':
|
|
|
2360 permit_unicode = c;
|
|
|
2361 continue;
|
|
|
2362
|
|
|
2363 /* #r"my raw string" -- raw string */
|
|
|
2364 case '\"':
|
|
|
2365 return read_string(readcharfun, '\"', 1, permit_unicode);
|
|
|
2366 /* invalid syntax */
|
|
|
2367 default:
|
|
|
2368 {
|
|
|
2369 if (permit_unicode)
|
|
|
2370 {
|
|
|
2371 unreadchar(readcharfun, permit_unicode);
|
|
|
2372 }
|
|
|
2373 unreadchar(readcharfun, c);
|
|
|
2374 return Fsignal(Qinvalid_read_syntax,
|
|
|
2375 list1(build_string
|
|
|
2376 ("unrecognized raw string syntax")));
|
|
|
2377 }
|
|
|
2378 }
|
|
|
2379 } while (1);
|
|
|
2380 }
|
|
|
2381
|
|
428
|
2382 /* Read the next Lisp object from the stream READCHARFUN and return it.
|
|
|
2383 If the return value is a cons whose car is Qunbound, then read1()
|
|
|
2384 encountered a misplaced token (e.g. a right bracket, right paren,
|
|
|
2385 or dot followed by a non-number). To filter this stuff out,
|
|
|
2386 use read0(). */
|
|
|
2387
|
|
|
2388 static Lisp_Object
|
|
|
2389 read1 (Lisp_Object readcharfun)
|
|
|
2390 {
|
|
867
|
2391 Ichar c;
|
|
428
|
2392
|
|
|
2393 retry:
|
|
|
2394 c = reader_nextchar (readcharfun);
|
|
|
2395
|
|
|
2396 switch (c)
|
|
|
2397 {
|
|
|
2398 case '(':
|
|
|
2399 {
|
|
|
2400 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
|
|
|
2401 /* if this is disabled, then other code in eval.c must be enabled */
|
|
867
|
2402 Ichar ch = reader_nextchar (readcharfun);
|
|
428
|
2403 switch (ch)
|
|
|
2404 {
|
|
|
2405 case '`':
|
|
|
2406 {
|
|
|
2407 Lisp_Object tem;
|
|
853
|
2408 int speccount = internal_bind_int (&old_backquote_flag,
|
|
|
2409 1 + old_backquote_flag);
|
|
428
|
2410 tem = read0 (readcharfun);
|
|
771
|
2411 unbind_to (speccount);
|
|
428
|
2412 ch = reader_nextchar (readcharfun);
|
|
|
2413 if (ch != ')')
|
|
|
2414 {
|
|
|
2415 unreadchar (readcharfun, ch);
|
|
|
2416 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2417 list1 (build_msg_string
|
|
428
|
2418 ("Weird old-backquote syntax")));
|
|
|
2419 }
|
|
|
2420 return list2 (Qbacktick, tem);
|
|
|
2421 }
|
|
|
2422 case ',':
|
|
|
2423 {
|
|
|
2424 if (old_backquote_flag)
|
|
|
2425 {
|
|
|
2426 Lisp_Object tem, comma_type;
|
|
|
2427 ch = readchar (readcharfun);
|
|
|
2428 if (ch == '@')
|
|
|
2429 comma_type = Qcomma_at;
|
|
|
2430 else
|
|
|
2431 {
|
|
|
2432 if (ch >= 0)
|
|
|
2433 unreadchar (readcharfun, ch);
|
|
|
2434 comma_type = Qcomma;
|
|
|
2435 }
|
|
|
2436 tem = read0 (readcharfun);
|
|
|
2437 ch = reader_nextchar (readcharfun);
|
|
|
2438 if (ch != ')')
|
|
|
2439 {
|
|
|
2440 unreadchar (readcharfun, ch);
|
|
|
2441 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2442 list1 (build_msg_string
|
|
428
|
2443 ("Weird old-backquote syntax")));
|
|
|
2444 }
|
|
|
2445 return list2 (comma_type, tem);
|
|
|
2446 }
|
|
|
2447 else
|
|
|
2448 {
|
|
|
2449 unreadchar (readcharfun, ch);
|
|
|
2450 #if 0
|
|
|
2451 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2452 list1 (build_msg_string ("Comma outside of backquote")));
|
|
428
|
2453 #else
|
|
|
2454 /* #### - yuck....but this is reverse compatible. */
|
|
|
2455 /* mostly this is required by edebug, which does its own
|
|
|
2456 annotated reading. We need to have an annotated_read
|
|
|
2457 function that records (with markers) the buffer
|
|
|
2458 positions of the elements that make up lists, then that
|
|
|
2459 can be used in edebug and bytecomp and the check above
|
|
|
2460 can go back in. --Stig */
|
|
|
2461 break;
|
|
|
2462 #endif
|
|
|
2463 }
|
|
|
2464 }
|
|
|
2465 default:
|
|
|
2466 unreadchar (readcharfun, ch);
|
|
|
2467 } /* switch(ch) */
|
|
|
2468 #endif /* old backquote crap... */
|
|
|
2469 return read_list (readcharfun, ')', 1, 1);
|
|
|
2470 }
|
|
|
2471 case '[':
|
|
|
2472 return read_vector (readcharfun, ']');
|
|
|
2473
|
|
|
2474 case ')':
|
|
|
2475 case ']':
|
|
|
2476 /* #### - huh? these don't do what they seem... */
|
|
|
2477 return noseeum_cons (Qunbound, make_char (c));
|
|
|
2478 case '.':
|
|
|
2479 {
|
|
|
2480 /* If a period is followed by a number, then we should read it
|
|
|
2481 as a floating point number. Otherwise, it denotes a dotted
|
|
|
2482 pair.
|
|
|
2483 */
|
|
|
2484 c = readchar (readcharfun);
|
|
|
2485 unreadchar (readcharfun, c);
|
|
|
2486
|
|
867
|
2487 /* Can't use isdigit on Ichars */
|
|
428
|
2488 if (c < '0' || c > '9')
|
|
|
2489 return noseeum_cons (Qunbound, make_char ('.'));
|
|
|
2490
|
|
|
2491 /* Note that read_atom will loop
|
|
|
2492 at least once, assuring that we will not try to UNREAD
|
|
|
2493 two characters in a row.
|
|
|
2494 (I think this doesn't matter anymore because there should
|
|
|
2495 be no more danger in unreading multiple characters) */
|
|
|
2496 return read_atom (readcharfun, '.', 0);
|
|
|
2497 }
|
|
|
2498
|
|
|
2499 case '#':
|
|
|
2500 {
|
|
|
2501 c = readchar (readcharfun);
|
|
|
2502 switch (c)
|
|
|
2503 {
|
|
|
2504 #if 0 /* FSFmacs silly char-table syntax */
|
|
|
2505 case '^':
|
|
|
2506 #endif
|
|
|
2507 #if 0 /* FSFmacs silly bool-vector syntax */
|
|
|
2508 case '&':
|
|
|
2509 #endif
|
|
|
2510 /* "#["-- byte-code constant syntax */
|
|
|
2511 /* purecons #[...] syntax */
|
|
|
2512 case '[': return read_compiled_function (readcharfun, ']'
|
|
|
2513 /*, purify_flag */ );
|
|
|
2514 /* "#:"-- gensym syntax */
|
|
|
2515 case ':': return read_atom (readcharfun, -1, 1);
|
|
|
2516 /* #'x => (function x) */
|
|
|
2517 case '\'': return list2 (Qfunction, read0 (readcharfun));
|
|
|
2518 #if 0
|
|
|
2519 /* RMS uses this syntax for fat-strings.
|
|
|
2520 If we use it for vectors, then obscure bugs happen.
|
|
|
2521 */
|
|
|
2522 /* "#(" -- Scheme/CL vector syntax */
|
|
|
2523 case '(': return read_vector (readcharfun, ')');
|
|
|
2524 #endif
|
|
|
2525 #if 0 /* FSFmacs */
|
|
|
2526 case '(':
|
|
|
2527 {
|
|
|
2528 Lisp_Object tmp;
|
|
|
2529 struct gcpro gcpro1;
|
|
|
2530
|
|
|
2531 /* Read the string itself. */
|
|
|
2532 tmp = read1 (readcharfun);
|
|
|
2533 if (!STRINGP (tmp))
|
|
|
2534 {
|
|
|
2535 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
|
|
853
|
2536 free_cons (tmp);
|
|
428
|
2537 return Fsignal (Qinvalid_read_syntax,
|
|
|
2538 list1 (build_string ("#")));
|
|
|
2539 }
|
|
|
2540 GCPRO1 (tmp);
|
|
|
2541 /* Read the intervals and their properties. */
|
|
|
2542 while (1)
|
|
|
2543 {
|
|
|
2544 Lisp_Object beg, end, plist;
|
|
867
|
2545 Ichar ch;
|
|
428
|
2546 int invalid = 0;
|
|
|
2547
|
|
|
2548 beg = read1 (readcharfun);
|
|
|
2549 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
|
|
|
2550 {
|
|
|
2551 ch = XCHAR (XCDR (beg));
|
|
853
|
2552 free_cons (beg);
|
|
428
|
2553 if (ch == ')')
|
|
|
2554 break;
|
|
|
2555 else
|
|
|
2556 invalid = 1;
|
|
|
2557 }
|
|
|
2558 if (!invalid)
|
|
|
2559 {
|
|
|
2560 end = read1 (readcharfun);
|
|
|
2561 if (CONSP (end) && UNBOUNDP (XCAR (end)))
|
|
|
2562 {
|
|
853
|
2563 free_cons (end);
|
|
428
|
2564 invalid = 1;
|
|
|
2565 }
|
|
|
2566 }
|
|
|
2567 if (!invalid)
|
|
|
2568 {
|
|
|
2569 plist = read1 (readcharfun);
|
|
|
2570 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
|
|
|
2571 {
|
|
853
|
2572 free_cons (plist);
|
|
428
|
2573 invalid = 1;
|
|
|
2574 }
|
|
|
2575 }
|
|
|
2576 if (invalid)
|
|
|
2577 RETURN_UNGCPRO
|
|
|
2578 (Fsignal (Qinvalid_read_syntax,
|
|
|
2579 list2
|
|
771
|
2580 (build_msg_string ("invalid string property list"),
|
|
428
|
2581 XCDR (plist))));
|
|
|
2582 Fset_text_properties (beg, end, plist, tmp);
|
|
|
2583 }
|
|
|
2584 UNGCPRO;
|
|
|
2585 return tmp;
|
|
|
2586 }
|
|
|
2587 #endif /* 0 */
|
|
|
2588 case '@':
|
|
|
2589 {
|
|
|
2590 /* #@NUMBER is used to skip NUMBER following characters.
|
|
|
2591 That's used in .elc files to skip over doc strings
|
|
|
2592 and function definitions. */
|
|
|
2593 int i, nskip = 0;
|
|
|
2594
|
|
|
2595 /* Read a decimal integer. */
|
|
|
2596 while ((c = readchar (readcharfun)) >= 0
|
|
|
2597 && c >= '0' && c <= '9')
|
|
|
2598 nskip = (10 * nskip) + (c - '0');
|
|
|
2599 if (c >= 0)
|
|
|
2600 unreadchar (readcharfun, c);
|
|
|
2601
|
|
|
2602 /* FSF has code here that maybe caches the skipped
|
|
|
2603 string. See above for why this is totally
|
|
|
2604 losing. We handle this differently. */
|
|
|
2605
|
|
|
2606 /* Skip that many characters. */
|
|
|
2607 for (i = 0; i < nskip && c >= 0; i++)
|
|
|
2608 c = readchar (readcharfun);
|
|
|
2609
|
|
|
2610 goto retry;
|
|
|
2611 }
|
|
|
2612 case '$': return Vload_file_name_internal;
|
|
|
2613 /* bit vectors */
|
|
|
2614 case '*': return read_bit_vector (readcharfun);
|
|
|
2615 /* #o10 => 8 -- octal constant syntax */
|
|
|
2616 case 'o': return read_integer (readcharfun, 8);
|
|
|
2617 /* #xdead => 57005 -- hex constant syntax */
|
|
|
2618 case 'x': return read_integer (readcharfun, 16);
|
|
|
2619 /* #b010 => 2 -- binary constant syntax */
|
|
|
2620 case 'b': return read_integer (readcharfun, 2);
|
|
3543
|
2621 /* #r"raw\stringt" -- raw string syntax */
|
|
|
2622 case 'r': return read_raw_string(readcharfun);
|
|
428
|
2623 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
|
|
|
2624 case 's': return read_structure (readcharfun);
|
|
|
2625 case '<':
|
|
|
2626 {
|
|
|
2627 unreadchar (readcharfun, c);
|
|
|
2628 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2629 list1 (build_msg_string ("Cannot read unreadable object")));
|
|
428
|
2630 }
|
|
|
2631 #ifdef FEATUREP_SYNTAX
|
|
|
2632 case '+':
|
|
|
2633 case '-':
|
|
|
2634 {
|
|
456
|
2635 Lisp_Object feature_exp, obj, tem;
|
|
428
|
2636 struct gcpro gcpro1, gcpro2;
|
|
|
2637
|
|
456
|
2638 feature_exp = read0(readcharfun);
|
|
428
|
2639 obj = read0(readcharfun);
|
|
|
2640
|
|
|
2641 /* the call to `featurep' may GC. */
|
|
456
|
2642 GCPRO2 (feature_exp, obj);
|
|
|
2643 tem = call1 (Qfeaturep, feature_exp);
|
|
428
|
2644 UNGCPRO;
|
|
|
2645
|
|
|
2646 if (c == '+' && NILP(tem)) goto retry;
|
|
|
2647 if (c == '-' && !NILP(tem)) goto retry;
|
|
|
2648 return obj;
|
|
|
2649 }
|
|
|
2650 #endif
|
|
|
2651 case '0': case '1': case '2': case '3': case '4':
|
|
|
2652 case '5': case '6': case '7': case '8': case '9':
|
|
|
2653 /* Reader forms that can reuse previously read objects. */
|
|
|
2654 {
|
|
|
2655 int n = 0;
|
|
|
2656 Lisp_Object found;
|
|
|
2657
|
|
|
2658 /* Using read_integer() here is impossible, because it
|
|
|
2659 chokes on `='. Using parse_integer() is too hard.
|
|
|
2660 So we simply read it in, and ignore overflows, which
|
|
|
2661 is safe. */
|
|
|
2662 while (c >= '0' && c <= '9')
|
|
|
2663 {
|
|
|
2664 n *= 10;
|
|
|
2665 n += c - '0';
|
|
|
2666 c = readchar (readcharfun);
|
|
|
2667 }
|
|
|
2668 found = assq_no_quit (make_int (n), Vread_objects);
|
|
|
2669 if (c == '=')
|
|
|
2670 {
|
|
|
2671 /* #n=object returns object, but associates it with
|
|
|
2672 n for #n#. */
|
|
|
2673 Lisp_Object obj;
|
|
|
2674 if (CONSP (found))
|
|
|
2675 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2676 list2 (build_msg_string
|
|
428
|
2677 ("Multiply defined symbol label"),
|
|
|
2678 make_int (n)));
|
|
|
2679 obj = read0 (readcharfun);
|
|
|
2680 Vread_objects = Fcons (Fcons (make_int (n), obj),
|
|
|
2681 Vread_objects);
|
|
|
2682 return obj;
|
|
|
2683 }
|
|
|
2684 else if (c == '#')
|
|
|
2685 {
|
|
|
2686 /* #n# returns a previously read object. */
|
|
|
2687 if (CONSP (found))
|
|
|
2688 return XCDR (found);
|
|
|
2689 else
|
|
|
2690 return Fsignal (Qinvalid_read_syntax,
|
|
771
|
2691 list2 (build_msg_string
|
|
428
|
2692 ("Undefined symbol label"),
|
|
|
2693 make_int (n)));
|
|
|
2694 }
|
|
|
2695 return Fsignal (Qinvalid_read_syntax,
|
|
|
2696 list1 (build_string ("#")));
|
|
|
2697 }
|
|
|
2698 default:
|
|
|
2699 {
|
|
|
2700 unreadchar (readcharfun, c);
|
|
|
2701 return Fsignal (Qinvalid_read_syntax,
|
|
|
2702 list1 (build_string ("#")));
|
|
|
2703 }
|
|
|
2704 }
|
|
|
2705 }
|
|
|
2706
|
|
|
2707 /* Quote */
|
|
|
2708 case '\'': return list2 (Qquote, read0 (readcharfun));
|
|
|
2709
|
|
|
2710 #ifdef LISP_BACKQUOTES
|
|
|
2711 case '`':
|
|
|
2712 {
|
|
|
2713 Lisp_Object tem;
|
|
853
|
2714 int speccount = internal_bind_int (&new_backquote_flag,
|
|
|
2715 1 + new_backquote_flag);
|
|
428
|
2716 tem = read0 (readcharfun);
|
|
771
|
2717 unbind_to (speccount);
|
|
428
|
2718 return list2 (Qbackquote, tem);
|
|
|
2719 }
|
|
|
2720
|
|
|
2721 case ',':
|
|
|
2722 {
|
|
|
2723 if (new_backquote_flag)
|
|
|
2724 {
|
|
|
2725 Lisp_Object comma_type = Qnil;
|
|
|
2726 int ch = readchar (readcharfun);
|
|
|
2727
|
|
|
2728 if (ch == '@')
|
|
|
2729 comma_type = Qcomma_at;
|
|
|
2730 else if (ch == '.')
|
|
|
2731 comma_type = Qcomma_dot;
|
|
|
2732 else
|
|
|
2733 {
|
|
|
2734 if (ch >= 0)
|
|
|
2735 unreadchar (readcharfun, ch);
|
|
|
2736 comma_type = Qcomma;
|
|
|
2737 }
|
|
|
2738 return list2 (comma_type, read0 (readcharfun));
|
|
|
2739 }
|
|
|
2740 else
|
|
|
2741 {
|
|
|
2742 /* YUCK. 99.999% backwards compatibility. The Right
|
|
|
2743 Thing(tm) is to signal an error here, because it's
|
|
|
2744 really invalid read syntax. Instead, this permits
|
|
|
2745 commas to begin symbols (unless they're inside
|
|
|
2746 backquotes). If an error is signalled here in the
|
|
|
2747 future, then commas should be invalid read syntax
|
|
|
2748 outside of backquotes anywhere they're found (i.e.
|
|
|
2749 they must be quoted in symbols) -- Stig */
|
|
|
2750 return read_atom (readcharfun, c, 0);
|
|
|
2751 }
|
|
|
2752 }
|
|
|
2753 #endif
|
|
|
2754
|
|
|
2755 case '?':
|
|
|
2756 {
|
|
|
2757 /* Evil GNU Emacs "character" (ie integer) syntax */
|
|
|
2758 c = readchar (readcharfun);
|
|
|
2759 if (c < 0)
|
|
|
2760 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
|
|
|
2761
|
|
|
2762 if (c == '\\')
|
|
|
2763 c = read_escape (readcharfun);
|
|
|
2764 return make_char (c);
|
|
|
2765 }
|
|
|
2766
|
|
|
2767 case '\"':
|
|
3543
|
2768 /* String */
|
|
|
2769 return read_string(readcharfun, '\"', 0, 1);
|
|
428
|
2770
|
|
|
2771 default:
|
|
|
2772 {
|
|
|
2773 /* Ignore whitespace and control characters */
|
|
|
2774 if (c <= 040)
|
|
|
2775 goto retry;
|
|
|
2776 return read_atom (readcharfun, c, 0);
|
|
|
2777 }
|
|
|
2778 }
|
|
|
2779 }
|
|
|
2780
|
|
|
2781
|
|
|
2782
|
|
|
2783 #define LEAD_INT 1
|
|
|
2784 #define DOT_CHAR 2
|
|
|
2785 #define TRAIL_INT 4
|
|
|
2786 #define E_CHAR 8
|
|
|
2787 #define EXP_INT 16
|
|
|
2788
|
|
|
2789 int
|
|
442
|
2790 isfloat_string (const char *cp)
|
|
428
|
2791 {
|
|
|
2792 int state = 0;
|
|
867
|
2793 const Ibyte *ucp = (const Ibyte *) cp;
|
|
428
|
2794
|
|
|
2795 if (*ucp == '+' || *ucp == '-')
|
|
|
2796 ucp++;
|
|
|
2797
|
|
|
2798 if (*ucp >= '0' && *ucp <= '9')
|
|
|
2799 {
|
|
|
2800 state |= LEAD_INT;
|
|
|
2801 while (*ucp >= '0' && *ucp <= '9')
|
|
|
2802 ucp++;
|
|
|
2803 }
|
|
|
2804 if (*ucp == '.')
|
|
|
2805 {
|
|
|
2806 state |= DOT_CHAR;
|
|
|
2807 ucp++;
|
|
|
2808 }
|
|
|
2809 if (*ucp >= '0' && *ucp <= '9')
|
|
|
2810 {
|
|
|
2811 state |= TRAIL_INT;
|
|
|
2812 while (*ucp >= '0' && *ucp <= '9')
|
|
|
2813 ucp++;
|
|
|
2814 }
|
|
|
2815 if (*ucp == 'e' || *ucp == 'E')
|
|
|
2816 {
|
|
|
2817 state |= E_CHAR;
|
|
|
2818 ucp++;
|
|
|
2819 if ((*ucp == '+') || (*ucp == '-'))
|
|
|
2820 ucp++;
|
|
|
2821 }
|
|
|
2822
|
|
|
2823 if (*ucp >= '0' && *ucp <= '9')
|
|
|
2824 {
|
|
|
2825 state |= EXP_INT;
|
|
|
2826 while (*ucp >= '0' && *ucp <= '9')
|
|
|
2827 ucp++;
|
|
|
2828 }
|
|
|
2829 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
|
|
|
2830 || (*ucp == '\r') || (*ucp == '\f'))
|
|
|
2831 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
|
|
|
2832 || state == (DOT_CHAR|TRAIL_INT)
|
|
|
2833 || state == (LEAD_INT|E_CHAR|EXP_INT)
|
|
|
2834 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
|
|
|
2835 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
|
|
|
2836 }
|
|
1983
|
2837
|
|
|
2838 #ifdef HAVE_RATIO
|
|
|
2839 int
|
|
|
2840 isratio_string (const char *cp)
|
|
|
2841 {
|
|
2010
|
2842 /* Possible minus/plus sign */
|
|
|
2843 if (*cp == '-' || *cp == '+')
|
|
1983
|
2844 cp++;
|
|
|
2845
|
|
|
2846 /* Numerator */
|
|
|
2847 if (*cp < '0' || *cp > '9')
|
|
|
2848 return 0;
|
|
|
2849
|
|
|
2850 do {
|
|
|
2851 cp++;
|
|
|
2852 } while (*cp >= '0' && *cp <= '9');
|
|
|
2853
|
|
|
2854 /* Slash */
|
|
|
2855 if (*cp++ != '/')
|
|
|
2856 return 0;
|
|
|
2857
|
|
|
2858 /* Denominator */
|
|
|
2859 if (*cp < '0' || *cp > '9')
|
|
|
2860 return 0;
|
|
|
2861
|
|
|
2862 do {
|
|
|
2863 cp++;
|
|
|
2864 } while (*cp >= '0' && *cp <= '9');
|
|
|
2865
|
|
|
2866 return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
|
|
|
2867 *cp == '\r' || *cp == '\f';
|
|
|
2868 }
|
|
|
2869 #endif
|
|
428
|
2870
|
|
|
2871 static void *
|
|
|
2872 sequence_reader (Lisp_Object readcharfun,
|
|
867
|
2873 Ichar terminator,
|
|
428
|
2874 void *state,
|
|
|
2875 void * (*conser) (Lisp_Object readcharfun,
|
|
|
2876 void *state, Charcount len))
|
|
|
2877 {
|
|
|
2878 Charcount len;
|
|
|
2879
|
|
|
2880 for (len = 0; ; len++)
|
|
|
2881 {
|
|
867
|
2882 Ichar ch;
|
|
428
|
2883
|
|
|
2884 QUIT;
|
|
|
2885 ch = reader_nextchar (readcharfun);
|
|
|
2886
|
|
|
2887 if (ch == terminator)
|
|
|
2888 return state;
|
|
|
2889 else
|
|
|
2890 unreadchar (readcharfun, ch);
|
|
|
2891 #ifdef FEATUREP_SYNTAX
|
|
|
2892 if (ch == ']')
|
|
442
|
2893 read_syntax_error ("\"]\" in a list");
|
|
428
|
2894 else if (ch == ')')
|
|
442
|
2895 read_syntax_error ("\")\" in a vector");
|
|
428
|
2896 #endif
|
|
|
2897 state = ((conser) (readcharfun, state, len));
|
|
|
2898 }
|
|
|
2899 }
|
|
|
2900
|
|
|
2901
|
|
|
2902 struct read_list_state
|
|
|
2903 {
|
|
|
2904 Lisp_Object head;
|
|
|
2905 Lisp_Object tail;
|
|
|
2906 int length;
|
|
|
2907 int allow_dotted_lists;
|
|
867
|
2908 Ichar terminator;
|
|
428
|
2909 };
|
|
|
2910
|
|
|
2911 static void *
|
|
2286
|
2912 read_list_conser (Lisp_Object readcharfun, void *state, Charcount UNUSED (len))
|
|
428
|
2913 {
|
|
|
2914 struct read_list_state *s = (struct read_list_state *) state;
|
|
|
2915 Lisp_Object elt;
|
|
|
2916
|
|
|
2917 elt = read1 (readcharfun);
|
|
|
2918
|
|
|
2919 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
|
|
|
2920 {
|
|
|
2921 Lisp_Object tem = elt;
|
|
867
|
2922 Ichar ch;
|
|
428
|
2923
|
|
|
2924 elt = XCDR (elt);
|
|
853
|
2925 free_cons (tem);
|
|
428
|
2926 tem = Qnil;
|
|
|
2927 ch = XCHAR (elt);
|
|
|
2928 #ifdef FEATUREP_SYNTAX
|
|
|
2929 if (ch == s->terminator) /* deal with #+, #- reader macros */
|
|
|
2930 {
|
|
|
2931 unreadchar (readcharfun, s->terminator);
|
|
|
2932 goto done;
|
|
|
2933 }
|
|
|
2934 else if (ch == ']')
|
|
442
|
2935 read_syntax_error ("']' in a list");
|
|
428
|
2936 else if (ch == ')')
|
|
442
|
2937 read_syntax_error ("')' in a vector");
|
|
428
|
2938 else
|
|
|
2939 #endif
|
|
|
2940 if (ch != '.')
|
|
563
|
2941 signal_error (Qinternal_error, "BUG! Internal reader error", elt);
|
|
428
|
2942 else if (!s->allow_dotted_lists)
|
|
442
|
2943 read_syntax_error ("\".\" in a vector");
|
|
428
|
2944 else
|
|
|
2945 {
|
|
|
2946 if (!NILP (s->tail))
|
|
|
2947 XCDR (s->tail) = read0 (readcharfun);
|
|
|
2948 else
|
|
|
2949 s->head = read0 (readcharfun);
|
|
|
2950 elt = read1 (readcharfun);
|
|
|
2951 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
|
|
|
2952 {
|
|
|
2953 ch = XCHAR (XCDR (elt));
|
|
853
|
2954 free_cons (elt);
|
|
428
|
2955 if (ch == s->terminator)
|
|
|
2956 {
|
|
|
2957 unreadchar (readcharfun, s->terminator);
|
|
|
2958 goto done;
|
|
|
2959 }
|
|
|
2960 }
|
|
442
|
2961 read_syntax_error (". in wrong context");
|
|
428
|
2962 }
|
|
|
2963 }
|
|
|
2964
|
|
|
2965 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
2966 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
|
|
|
2967 {
|
|
|
2968 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
|
|
|
2969 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
|
|
|
2970 else
|
|
|
2971 Vcurrent_compiled_function_annotation = elt;
|
|
|
2972 }
|
|
|
2973 #endif
|
|
|
2974
|
|
|
2975 elt = Fcons (elt, Qnil);
|
|
|
2976 if (!NILP (s->tail))
|
|
|
2977 XCDR (s->tail) = elt;
|
|
|
2978 else
|
|
|
2979 s->head = elt;
|
|
|
2980 s->tail = elt;
|
|
|
2981 done:
|
|
|
2982 s->length++;
|
|
|
2983 return s;
|
|
|
2984 }
|
|
|
2985
|
|
|
2986
|
|
814
|
2987 /* allow_dotted_lists means that something like (foo bar . baz)
|
|
|
2988 is acceptable. If -1, means check for starting with defun
|
|
|
2989 and make structure pure. (not implemented, probably for very
|
|
|
2990 good reasons)
|
|
|
2991
|
|
|
2992 If check_for_doc_references, look for (#$ . INT) doc references
|
|
|
2993 in the list and record if load_force_doc_strings is non-zero.
|
|
|
2994 (Such doc references will be destroyed during the loadup phase
|
|
|
2995 by replacing with Qzero, because Snarf-documentation will fill
|
|
|
2996 them in again.)
|
|
|
2997
|
|
|
2998 WARNING: If you set this, you sure as hell better not call
|
|
|
2999 free_list() on the returned list here.
|
|
|
3000 */
|
|
428
|
3001
|
|
|
3002 static Lisp_Object
|
|
|
3003 read_list (Lisp_Object readcharfun,
|
|
867
|
3004 Ichar terminator,
|
|
428
|
3005 int allow_dotted_lists,
|
|
|
3006 int check_for_doc_references)
|
|
|
3007 {
|
|
|
3008 struct read_list_state s;
|
|
|
3009 struct gcpro gcpro1, gcpro2;
|
|
|
3010 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
3011 Lisp_Object old_compiled_function_annotation =
|
|
|
3012 Vcurrent_compiled_function_annotation;
|
|
|
3013 #endif
|
|
|
3014
|
|
|
3015 s.head = Qnil;
|
|
|
3016 s.tail = Qnil;
|
|
|
3017 s.length = 0;
|
|
|
3018 s.allow_dotted_lists = allow_dotted_lists;
|
|
|
3019 s.terminator = terminator;
|
|
|
3020 GCPRO2 (s.head, s.tail);
|
|
|
3021
|
|
|
3022 sequence_reader (readcharfun, terminator, &s, read_list_conser);
|
|
|
3023 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
3024 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
|
|
|
3025 #endif
|
|
|
3026
|
|
|
3027 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
|
|
|
3028 {
|
|
|
3029 /* check now for any doc string references and record them
|
|
|
3030 for later. */
|
|
|
3031 Lisp_Object tail;
|
|
|
3032
|
|
|
3033 /* We might be dealing with an imperfect list so don't
|
|
|
3034 use LIST_LOOP */
|
|
|
3035 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
|
|
|
3036 {
|
|
|
3037 Lisp_Object holding_cons = Qnil;
|
|
|
3038
|
|
|
3039 {
|
|
|
3040 Lisp_Object elem = XCAR (tail);
|
|
|
3041 /* elem might be (#$ . INT) ... */
|
|
|
3042 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
|
|
|
3043 holding_cons = tail;
|
|
|
3044 /* or it might be (quote (#$ . INT)) i.e.
|
|
|
3045 (quote . ((#$ . INT) . nil)) in the case of
|
|
|
3046 `autoload' (autoload evaluates its arguments, while
|
|
|
3047 `defvar', `defun', etc. don't). */
|
|
|
3048 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
|
|
|
3049 && CONSP (XCDR (elem)))
|
|
|
3050 {
|
|
|
3051 elem = XCAR (XCDR (elem));
|
|
|
3052 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
|
|
|
3053 holding_cons = XCDR (XCAR (tail));
|
|
|
3054 }
|
|
|
3055 }
|
|
|
3056
|
|
|
3057 if (CONSP (holding_cons))
|
|
|
3058 {
|
|
|
3059 if (purify_flag)
|
|
|
3060 {
|
|
|
3061 if (NILP (Vinternal_doc_file_name))
|
|
|
3062 /* We have not yet called Snarf-documentation, so
|
|
|
3063 assume this file is described in the DOC file
|
|
|
3064 and Snarf-documentation will fill in the right
|
|
|
3065 value later. For now, replace the whole list
|
|
|
3066 with 0. */
|
|
|
3067 XCAR (holding_cons) = Qzero;
|
|
|
3068 else
|
|
|
3069 /* We have already called Snarf-documentation, so
|
|
|
3070 make a relative file name for this file, so it
|
|
|
3071 can be found properly in the installed Lisp
|
|
|
3072 directory. We don't use Fexpand_file_name
|
|
|
3073 because that would make the directory absolute
|
|
|
3074 now. */
|
|
|
3075 XCAR (XCAR (holding_cons)) =
|
|
|
3076 concat2 (build_string ("../lisp/"),
|
|
|
3077 Ffile_name_nondirectory
|
|
|
3078 (Vload_file_name_internal));
|
|
|
3079 }
|
|
|
3080 else
|
|
|
3081 /* Not pure. Just add to Vload_force_doc_string_list,
|
|
|
3082 and the string will be filled in properly in
|
|
|
3083 load_force_doc_string_unwind(). */
|
|
|
3084 Vload_force_doc_string_list =
|
|
|
3085 /* We pass the cons that holds the (#$ . INT) so we
|
|
|
3086 can modify it in-place. */
|
|
|
3087 Fcons (holding_cons, Vload_force_doc_string_list);
|
|
|
3088 }
|
|
|
3089 }
|
|
|
3090 }
|
|
|
3091
|
|
|
3092 UNGCPRO;
|
|
|
3093 return s.head;
|
|
|
3094 }
|
|
|
3095
|
|
|
3096 static Lisp_Object
|
|
|
3097 read_vector (Lisp_Object readcharfun,
|
|
867
|
3098 Ichar terminator)
|
|
428
|
3099 {
|
|
|
3100 Lisp_Object tem;
|
|
|
3101 Lisp_Object *p;
|
|
|
3102 int len;
|
|
|
3103 int i;
|
|
|
3104 struct read_list_state s;
|
|
|
3105 struct gcpro gcpro1, gcpro2;
|
|
|
3106
|
|
|
3107 s.head = Qnil;
|
|
|
3108 s.tail = Qnil;
|
|
|
3109 s.length = 0;
|
|
|
3110 s.allow_dotted_lists = 0;
|
|
|
3111 GCPRO2 (s.head, s.tail);
|
|
|
3112
|
|
|
3113 sequence_reader (readcharfun, terminator, &s, read_list_conser);
|
|
|
3114
|
|
|
3115 UNGCPRO;
|
|
|
3116 tem = s.head;
|
|
|
3117 len = XINT (Flength (tem));
|
|
|
3118
|
|
814
|
3119 s.head = make_vector (len, Qnil);
|
|
428
|
3120
|
|
|
3121 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
|
|
|
3122 i < len;
|
|
|
3123 i++, p++)
|
|
|
3124 {
|
|
853
|
3125 Lisp_Object otem = tem;
|
|
428
|
3126 tem = Fcar (tem);
|
|
|
3127 *p = tem;
|
|
853
|
3128 tem = XCDR (otem);
|
|
428
|
3129 free_cons (otem);
|
|
|
3130 }
|
|
|
3131 return s.head;
|
|
|
3132 }
|
|
|
3133
|
|
|
3134 static Lisp_Object
|
|
867
|
3135 read_compiled_function (Lisp_Object readcharfun, Ichar terminator)
|
|
428
|
3136 {
|
|
|
3137 /* Accept compiled functions at read-time so that we don't
|
|
|
3138 have to build them at load-time. */
|
|
|
3139 Lisp_Object stuff;
|
|
|
3140 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
|
|
|
3141 struct gcpro gcpro1;
|
|
|
3142 int len;
|
|
|
3143 int iii;
|
|
|
3144 int saw_a_doc_ref = 0;
|
|
|
3145
|
|
|
3146 /* Note: we tell read_list not to search for doc references
|
|
|
3147 because we need to handle the "doc reference" for the
|
|
|
3148 instructions and constants differently. */
|
|
|
3149 stuff = read_list (readcharfun, terminator, 0, 0);
|
|
|
3150 len = XINT (Flength (stuff));
|
|
|
3151 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
|
|
|
3152 return
|
|
442
|
3153 continuable_read_syntax_error ("#[...] used with wrong number of elements");
|
|
428
|
3154
|
|
|
3155 for (iii = 0; CONSP (stuff); iii++)
|
|
|
3156 {
|
|
853
|
3157 Lisp_Object victim = stuff;
|
|
428
|
3158 make_byte_code_args[iii] = Fcar (stuff);
|
|
|
3159 if ((purify_flag || load_force_doc_strings)
|
|
|
3160 && CONSP (make_byte_code_args[iii])
|
|
|
3161 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
|
|
|
3162 {
|
|
|
3163 if (purify_flag && iii == COMPILED_DOC_STRING)
|
|
|
3164 {
|
|
|
3165 /* same as in read_list(). */
|
|
|
3166 if (NILP (Vinternal_doc_file_name))
|
|
|
3167 make_byte_code_args[iii] = Qzero;
|
|
|
3168 else
|
|
|
3169 XCAR (make_byte_code_args[iii]) =
|
|
|
3170 concat2 (build_string ("../lisp/"),
|
|
|
3171 Ffile_name_nondirectory
|
|
|
3172 (Vload_file_name_internal));
|
|
|
3173 }
|
|
|
3174 else
|
|
|
3175 saw_a_doc_ref = 1;
|
|
|
3176 }
|
|
|
3177 stuff = Fcdr (stuff);
|
|
|
3178 free_cons (victim);
|
|
|
3179 }
|
|
|
3180 GCPRO1 (make_byte_code_args[0]);
|
|
|
3181 gcpro1.nvars = len;
|
|
|
3182
|
|
|
3183 /* v18 or v19 bytecode file. Need to Ebolify. */
|
|
|
3184 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
|
|
|
3185 ebolify_bytecode_constants (make_byte_code_args[2]);
|
|
|
3186
|
|
|
3187 /* make-byte-code looks at purify_flag, which should have the same
|
|
|
3188 * value as our "read-pure" argument */
|
|
|
3189 stuff = Fmake_byte_code (len, make_byte_code_args);
|
|
|
3190 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
|
|
|
3191 if (saw_a_doc_ref)
|
|
|
3192 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
|
|
|
3193 UNGCPRO;
|
|
|
3194 return stuff;
|
|
|
3195 }
|
|
|
3196
|
|
|
3197
|
|
|
3198
|
|
|
3199 void
|
|
|
3200 init_lread (void)
|
|
|
3201 {
|
|
|
3202 Vvalues = Qnil;
|
|
|
3203
|
|
|
3204 load_in_progress = 0;
|
|
|
3205
|
|
|
3206 Vload_descriptor_list = Qnil;
|
|
|
3207
|
|
|
3208 /* kludge: locate-file does not work for a null load-path, even if
|
|
|
3209 the file name is absolute. */
|
|
|
3210
|
|
|
3211 Vload_path = Fcons (build_string (""), Qnil);
|
|
|
3212
|
|
|
3213 /* This used to get initialized in init_lread because all streams
|
|
|
3214 got closed when dumping occurs. This is no longer true --
|
|
|
3215 Vread_buffer_stream is a resizing output stream, and there is no
|
|
|
3216 reason to close it at dump-time.
|
|
|
3217
|
|
|
3218 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
|
|
|
3219 will initialize it only once, at dump-time. */
|
|
|
3220 if (NILP (Vread_buffer_stream))
|
|
|
3221 Vread_buffer_stream = make_resizing_buffer_output_stream ();
|
|
|
3222
|
|
|
3223 Vload_force_doc_string_list = Qnil;
|
|
|
3224 }
|
|
|
3225
|
|
|
3226 void
|
|
|
3227 syms_of_lread (void)
|
|
|
3228 {
|
|
|
3229 DEFSUBR (Fread);
|
|
|
3230 DEFSUBR (Fread_from_string);
|
|
|
3231 DEFSUBR (Fload_internal);
|
|
|
3232 DEFSUBR (Flocate_file);
|
|
|
3233 DEFSUBR (Flocate_file_clear_hashing);
|
|
|
3234 DEFSUBR (Feval_buffer);
|
|
|
3235 DEFSUBR (Feval_region);
|
|
|
3236
|
|
563
|
3237 DEFSYMBOL (Qstandard_input);
|
|
|
3238 DEFSYMBOL (Qread_char);
|
|
|
3239 DEFSYMBOL (Qload);
|
|
1292
|
3240 DEFSYMBOL (Qload_internal);
|
|
563
|
3241 DEFSYMBOL (Qfset);
|
|
428
|
3242
|
|
|
3243 #ifdef LISP_BACKQUOTES
|
|
563
|
3244 DEFSYMBOL (Qbackquote);
|
|
428
|
3245 defsymbol (&Qbacktick, "`");
|
|
|
3246 defsymbol (&Qcomma, ",");
|
|
|
3247 defsymbol (&Qcomma_at, ",@");
|
|
|
3248 defsymbol (&Qcomma_dot, ",.");
|
|
|
3249 #endif
|
|
|
3250
|
|
563
|
3251 DEFSYMBOL (Qexists);
|
|
|
3252 DEFSYMBOL (Qreadable);
|
|
|
3253 DEFSYMBOL (Qwritable);
|
|
|
3254 DEFSYMBOL (Qexecutable);
|
|
428
|
3255 }
|
|
|
3256
|
|
|
3257 void
|
|
|
3258 structure_type_create (void)
|
|
|
3259 {
|
|
|
3260 the_structure_type_dynarr = Dynarr_new (structure_type);
|
|
|
3261 }
|
|
|
3262
|
|
|
3263 void
|
|
|
3264 reinit_vars_of_lread (void)
|
|
|
3265 {
|
|
|
3266 Vread_buffer_stream = Qnil;
|
|
|
3267 staticpro_nodump (&Vread_buffer_stream);
|
|
|
3268 }
|
|
|
3269
|
|
|
3270 void
|
|
|
3271 vars_of_lread (void)
|
|
|
3272 {
|
|
|
3273 DEFVAR_LISP ("values", &Vvalues /*
|
|
|
3274 List of values of all expressions which were read, evaluated and printed.
|
|
|
3275 Order is reverse chronological.
|
|
|
3276 */ );
|
|
|
3277
|
|
|
3278 DEFVAR_LISP ("standard-input", &Vstandard_input /*
|
|
|
3279 Stream for read to get input from.
|
|
|
3280 See documentation of `read' for possible values.
|
|
|
3281 */ );
|
|
|
3282 Vstandard_input = Qt;
|
|
|
3283
|
|
|
3284 DEFVAR_LISP ("load-path", &Vload_path /*
|
|
|
3285 *List of directories to search for files to load.
|
|
|
3286 Each element is a string (directory name) or nil (try default directory).
|
|
|
3287
|
|
|
3288 Note that the elements of this list *may not* begin with "~", so you must
|
|
|
3289 call `expand-file-name' on them before adding them to this list.
|
|
|
3290
|
|
|
3291 Initialized based on EMACSLOADPATH environment variable, if any,
|
|
|
3292 otherwise to default specified in by file `paths.h' when XEmacs was built.
|
|
|
3293 If there were no paths specified in `paths.h', then XEmacs chooses a default
|
|
|
3294 value for this variable by looking around in the file-system near the
|
|
|
3295 directory in which the XEmacs executable resides.
|
|
|
3296 */ );
|
|
|
3297 Vload_path = Qnil;
|
|
|
3298
|
|
|
3299 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
|
|
|
3300 "*Location of lisp files to be used when dumping ONLY."); */
|
|
|
3301
|
|
|
3302 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
|
|
|
3303 Non-nil iff inside of `load'.
|
|
|
3304 */ );
|
|
|
3305
|
|
2548
|
3306 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
|
|
|
3307 An alist of expressions controlling whether particular files can be loaded.
|
|
|
3308 Each element looks like (FILENAME EXPR).
|
|
|
3309 FILENAME should be a full pathname, but without the .el suffix.
|
|
|
3310 When `load' is run and is about to load the specified file, it evaluates
|
|
|
3311 the form to determine if the file can be loaded.
|
|
|
3312 This variable is normally initialized automatically.
|
|
|
3313 */ );
|
|
|
3314 Vload_suppress_alist = Qnil;
|
|
|
3315
|
|
428
|
3316 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
|
|
|
3317 An alist of expressions to be evalled when particular files are loaded.
|
|
|
3318 Each element looks like (FILENAME FORMS...).
|
|
|
3319 When `load' is run and the file-name argument is FILENAME,
|
|
|
3320 the FORMS in the corresponding element are executed at the end of loading.
|
|
|
3321
|
|
|
3322 FILENAME must match exactly! Normally FILENAME is the name of a library,
|
|
|
3323 with no directory specified, since that is how `load' is normally called.
|
|
|
3324 An error in FORMS does not undo the load,
|
|
|
3325 but does prevent execution of the rest of the FORMS.
|
|
|
3326 */ );
|
|
|
3327 Vafter_load_alist = Qnil;
|
|
|
3328
|
|
|
3329 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
|
|
|
3330 *Whether `load' should check whether the source is newer than the binary.
|
|
|
3331 If this variable is true, then when a `.elc' file is being loaded and the
|
|
|
3332 corresponding `.el' is newer, a warning message will be printed.
|
|
|
3333 */ );
|
|
1261
|
3334 load_warn_when_source_newer = 1;
|
|
428
|
3335
|
|
|
3336 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
|
|
|
3337 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
|
|
|
3338 If this variable is true, then when `load' is called with a filename without
|
|
|
3339 an extension, and the `.elc' version doesn't exist but the `.el' version does,
|
|
|
3340 then a message will be printed. If an explicit extension is passed to `load',
|
|
|
3341 no warning will be printed.
|
|
|
3342 */ );
|
|
|
3343 load_warn_when_source_only = 0;
|
|
|
3344
|
|
|
3345 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
|
|
|
3346 *Whether `load' should ignore `.elc' files when a suffix is not given.
|
|
|
3347 This is normally used only to bootstrap the `.elc' files when building XEmacs.
|
|
|
3348 */ );
|
|
|
3349 load_ignore_elc_files = 0;
|
|
|
3350
|
|
1123
|
3351 DEFVAR_BOOL ("load-ignore-out-of-date-elc-files",
|
|
|
3352 &load_ignore_out_of_date_elc_files /*
|
|
|
3353 *Whether `load' should ignore out-of-date `.elc' files when no suffix is given.
|
|
|
3354 This is normally used when compiling packages of elisp files that may have
|
|
|
3355 complex dependencies. Ignoring all elc files with `load-ignore-elc-files'
|
|
|
3356 would also be safe, but much slower.
|
|
|
3357 */ );
|
|
|
3358 load_ignore_out_of_date_elc_files = 0;
|
|
|
3359
|
|
|
3360 DEFVAR_BOOL ("load-always-display-messages",
|
|
|
3361 &load_always_display_messages /*
|
|
|
3362 *Whether `load' should always display loading messages.
|
|
|
3363 If this is true, every file loaded will be shown, regardless of the setting
|
|
|
3364 of the NOMESSAGE parameter, and even when files are loaded indirectly, e.g.
|
|
2857
|
3365 due to `require'.
|
|
1123
|
3366 */ );
|
|
|
3367 load_always_display_messages = 0;
|
|
|
3368
|
|
|
3369 DEFVAR_BOOL ("load-show-full-path-in-messages",
|
|
|
3370 &load_show_full_path_in_messages /*
|
|
|
3371 *Whether `load' should show the full path in all loading messages.
|
|
|
3372 */ );
|
|
|
3373 load_show_full_path_in_messages = 0;
|
|
|
3374
|
|
428
|
3375 #ifdef LOADHIST
|
|
|
3376 DEFVAR_LISP ("load-history", &Vload_history /*
|
|
|
3377 Alist mapping source file names to symbols and features.
|
|
|
3378 Each alist element is a list that starts with a file name,
|
|
|
3379 except for one element (optional) that starts with nil and describes
|
|
|
3380 definitions evaluated from buffers not visiting files.
|
|
|
3381 The remaining elements of each list are symbols defined as functions
|
|
|
3382 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
|
|
|
3383 */ );
|
|
|
3384 Vload_history = Qnil;
|
|
|
3385
|
|
|
3386 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
|
|
|
3387 Used for internal purposes by `load'.
|
|
|
3388 */ );
|
|
|
3389 Vcurrent_load_list = Qnil;
|
|
|
3390 #endif
|
|
|
3391
|
|
|
3392 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
|
|
|
3393 Full name of file being loaded by `load'.
|
|
|
3394 */ );
|
|
|
3395 Vload_file_name = Qnil;
|
|
|
3396
|
|
|
3397 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
|
|
|
3398 Function used by `load' and `eval-region' for reading expressions.
|
|
|
3399 The default is nil, which means use the function `read'.
|
|
|
3400 */ );
|
|
|
3401 Vload_read_function = Qnil;
|
|
|
3402
|
|
|
3403 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
|
|
|
3404 Non-nil means `load' should force-load all dynamic doc strings.
|
|
|
3405 This is useful when the file being loaded is a temporary copy.
|
|
|
3406 */ );
|
|
|
3407 load_force_doc_strings = 0;
|
|
|
3408
|
|
|
3409 /* See read_escape(). */
|
|
|
3410 #if 0
|
|
|
3411 /* Used to be named `puke-on-fsf-keys' */
|
|
|
3412 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
|
|
|
3413 &fail_on_bucky_bit_character_escapes /*
|
|
|
3414 Whether `read' should signal an error when it encounters unsupported
|
|
|
3415 character escape syntaxes or just read them incorrectly.
|
|
|
3416 */ );
|
|
|
3417 fail_on_bucky_bit_character_escapes = 0;
|
|
|
3418 #endif
|
|
|
3419
|
|
|
3420 /* This must be initialized in init_lread otherwise it may start out
|
|
|
3421 with values saved when the image is dumped. */
|
|
|
3422 staticpro (&Vload_descriptor_list);
|
|
|
3423
|
|
|
3424 /* Initialized in init_lread. */
|
|
|
3425 staticpro (&Vload_force_doc_string_list);
|
|
|
3426
|
|
|
3427 Vload_file_name_internal = Qnil;
|
|
|
3428 staticpro (&Vload_file_name_internal);
|
|
|
3429
|
|
|
3430 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
3431 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
3432 staticpro (&Vcurrent_compiled_function_annotation);
|
|
|
3433 #endif
|
|
|
3434
|
|
|
3435 /* So that early-early stuff will work */
|
|
1292
|
3436 Ffset (Qload, Qload_internal);
|
|
428
|
3437
|
|
|
3438 #ifdef FEATUREP_SYNTAX
|
|
563
|
3439 DEFSYMBOL (Qfeaturep);
|
|
771
|
3440 Fprovide (intern ("xemacs"));
|
|
428
|
3441 #ifdef INFODOCK
|
|
771
|
3442 Fprovide (intern ("infodock"));
|
|
428
|
3443 #endif /* INFODOCK */
|
|
|
3444 #endif /* FEATUREP_SYNTAX */
|
|
|
3445
|
|
|
3446 #ifdef LISP_BACKQUOTES
|
|
|
3447 old_backquote_flag = new_backquote_flag = 0;
|
|
|
3448 #endif
|
|
|
3449
|
|
|
3450 #ifdef I18N3
|
|
|
3451 Vfile_domain = Qnil;
|
|
|
3452 #endif
|
|
|
3453
|
|
|
3454 Vread_objects = Qnil;
|
|
|
3455 staticpro (&Vread_objects);
|
|
|
3456
|
|
|
3457 Vlocate_file_hash_table = make_lisp_hash_table (200,
|
|
|
3458 HASH_TABLE_NON_WEAK,
|
|
|
3459 HASH_TABLE_EQUAL);
|
|
|
3460 staticpro (&Vlocate_file_hash_table);
|
|
|
3461 #ifdef DEBUG_XEMACS
|
|
|
3462 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
|
|
|
3463 = Vlocate_file_hash_table;
|
|
|
3464 #endif
|
|
|
3465 }
|
