|
0
|
1 /* Lisp parsing and input streams.
|
|
|
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
|
|
|
3 Copyright (C) 1995 Tinker Systems.
|
|
|
4 Copyright (C) 1996 Ben Wing.
|
|
|
5
|
|
|
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 #ifndef standalone
|
|
|
31 #include "buffer.h"
|
|
|
32 #include "bytecode.h"
|
|
|
33 #include "commands.h"
|
|
|
34 #include "insdel.h"
|
|
|
35 #include "lstream.h"
|
|
|
36 #include "opaque.h"
|
|
|
37 #include "paths.h"
|
|
|
38 #endif
|
|
|
39
|
|
|
40 #include "sysfile.h"
|
|
|
41
|
|
|
42 #ifdef LISP_FLOAT_TYPE
|
|
|
43 #define THIS_FILENAME lread
|
|
|
44 #include "sysfloat.h"
|
|
|
45 #endif /* LISP_FLOAT_TYPE */
|
|
|
46
|
|
|
47 Lisp_Object Qread_char, Qstandard_input;
|
|
|
48 Lisp_Object Qvariable_documentation;
|
|
|
49 #define LISP_BACKQUOTES
|
|
|
50 #ifdef LISP_BACKQUOTES
|
|
|
51 /* FSFmacs says:
|
|
|
52
|
|
|
53 Nonzero means inside a new-style backquote
|
|
|
54 with no surrounding parentheses.
|
|
|
55 Fread initializes this to zero, so we need not specbind it
|
|
|
56 or worry about what happens to it when there is an error.
|
|
|
57
|
|
|
58 But this is fucking typical Stallman bogosity. Nested
|
|
|
59 backquotes are perfectly legal and fail utterly with
|
|
|
60 this silliness. */
|
|
|
61 static int new_backquote_flag, old_backquote_flag;
|
|
|
62 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
|
|
|
63 #endif
|
|
|
64 Lisp_Object Qvariable_domain; /* I18N3 */
|
|
|
65 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
|
|
|
66 Lisp_Object Qcurrent_load_list;
|
|
|
67 Lisp_Object Qload, Qload_file_name;
|
|
|
68 Lisp_Object Qlocate_file_hash_table;
|
|
|
69 Lisp_Object Qfset;
|
|
|
70
|
|
|
71 int puke_on_fsf_keys;
|
|
|
72
|
|
|
73 /* non-zero if inside `load' */
|
|
|
74 int load_in_progress;
|
|
|
75
|
|
|
76 /* Whether Fload_internal() should check whether the .el is newer
|
|
|
77 when loading .elc */
|
|
|
78 int load_warn_when_source_newer;
|
|
|
79 /* Whether Fload_internal() should check whether the .elc doesn't exist */
|
|
|
80 int load_warn_when_source_only;
|
|
|
81 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
|
|
|
82 int load_ignore_elc_files;
|
|
|
83
|
|
|
84 /* Directory in which the sources were found. */
|
|
|
85 Lisp_Object Vsource_directory;
|
|
|
86
|
|
|
87 /* Search path for files to be loaded. */
|
|
|
88 Lisp_Object Vload_path;
|
|
|
89
|
|
|
90 /* Search path for files when dumping. */
|
|
|
91 /* Lisp_Object Vdump_load_path; */
|
|
|
92
|
|
|
93 /* This is the user-visible association list that maps features to
|
|
|
94 lists of defs in their load files. */
|
|
|
95 Lisp_Object Vload_history;
|
|
|
96
|
|
|
97 /* This is used to build the load history. */
|
|
|
98 Lisp_Object Vcurrent_load_list;
|
|
|
99
|
|
|
100 /* Name of file actually being read by `load'. */
|
|
|
101 Lisp_Object Vload_file_name;
|
|
|
102
|
|
|
103 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
|
|
|
104 our #$ checks are reliable. */
|
|
|
105 Lisp_Object Vload_file_name_internal;
|
|
|
106
|
|
|
107 Lisp_Object Vload_file_name_internal_the_purecopy;
|
|
|
108
|
|
|
109 /* Function to use for reading, in `load' and friends. */
|
|
|
110 Lisp_Object Vload_read_function;
|
|
|
111
|
|
|
112 /* Nonzero means load should forcibly load all dynamic doc strings. */
|
|
|
113 /* Note that this always happens (with some special behavior) when
|
|
|
114 purify_flag is set. */
|
|
|
115 static int load_force_doc_strings;
|
|
|
116
|
|
|
117 /* List of descriptors now open for Fload_internal. */
|
|
|
118 static Lisp_Object Vload_descriptor_list;
|
|
|
119
|
|
|
120 /* In order to implement "load_force_doc_strings", we keep
|
|
|
121 a list of all the compiled-function objects and such
|
|
|
122 that we have created in the process of loading this file.
|
|
|
123 See the rant below.
|
|
|
124
|
|
|
125 We specbind this just like Vload_file_name, so there's no
|
|
|
126 problems with recursive loading. */
|
|
|
127 static Lisp_Object Vload_force_doc_string_list;
|
|
|
128
|
|
|
129 /* A resizing-buffer stream used to temporarily hold data while reading */
|
|
|
130 static Lisp_Object Vread_buffer_stream;
|
|
|
131
|
|
|
132 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
133 Lisp_Object Vcurrent_compiled_function_annotation;
|
|
|
134 #endif
|
|
|
135
|
|
|
136 /* An array describing all known built-in structure types */
|
|
|
137 static Structure_type_dynarr *the_structure_type_dynarr;
|
|
|
138
|
|
|
139 #if 0 /* FSFmacs defun hack */
|
|
|
140 /* When nonzero, read conses in pure space */
|
|
|
141 static int read_pure;
|
|
|
142 #endif
|
|
|
143
|
|
|
144 #if 0 /* FSFmacs bogosity */
|
|
|
145 /* For use within read-from-string (this reader is non-reentrant!!) */
|
|
|
146 static int read_from_string_index;
|
|
|
147 static int read_from_string_limit;
|
|
|
148 #endif
|
|
|
149
|
|
|
150 #if 0 /* More FSF implementation kludges. */
|
|
|
151 /* In order to implement load-force-doc-string, FSF saves the
|
|
|
152 #@-quoted string when it's seen, and goes back and retrieves
|
|
|
153 it later.
|
|
|
154
|
|
|
155 This approach is not only kludgy, but it in general won't work
|
|
|
156 correctly because there's no stack of remembered #@-quoted-strings
|
|
|
157 and those strings don't generally appear in the file in the same
|
|
|
158 order as their #$ references. (Yes, that is amazingly stupid too.
|
|
|
159 WHY IN THE FUCKING HELL CAN'T RMS EVER IMPLEMENT ANYTHING IN A SANE
|
|
|
160 WAY? It would be trivially easy to always encode the #@ string
|
|
|
161 [which is a comment, anyway] in the middle of the (#$ . INT) cons
|
|
|
162 reference. That way, it would be really easy to implement
|
|
|
163 load-force-doc-string in a non-kludgy way by just retrieving the
|
|
|
164 string immediately, because it's delivered on a silver platter.)
|
|
|
165
|
|
|
166 And finally, this stupid approach doesn't work under Mule, or
|
|
|
167 under MS-DOS or Windows NT, or under VMS, or any other place
|
|
|
168 where you either can't do an ftell() or don't get back a byte
|
|
|
169 count.
|
|
|
170
|
|
|
171 Oh, and one more lossage in this approach: If you attempt to
|
|
|
172 dump any ELC files that were compiled with `byte-compile-dynamic'
|
|
|
173 (as opposed to just `byte-compile-dynamic-docstring'), you
|
|
|
174 get hosed. FMH! (as the illustrious JWZ was prone to utter)
|
|
|
175
|
|
|
176 The approach we use is clean, solves all of these problems, and is
|
|
|
177 probably easier to implement anyway. We just save a list of all
|
|
|
178 the containing objects that have (#$ . INT) conses in them (this
|
|
|
179 will only be compiled-function objects and lists), and when the
|
|
|
180 file is finished loading, we go through and fill in all the
|
|
|
181 doc strings at once. */
|
|
|
182
|
|
|
183 /* This contains the last string skipped with #@. */
|
|
|
184 static char *saved_doc_string;
|
|
|
185 /* Length of buffer allocated in saved_doc_string. */
|
|
|
186 static int saved_doc_string_size;
|
|
|
187 /* Length of actual data in saved_doc_string. */
|
|
|
188 static int saved_doc_string_length;
|
|
|
189 /* This is the file position that string came from. */
|
|
|
190 static int saved_doc_string_position;
|
|
|
191 #endif
|
|
|
192
|
|
|
193
|
|
|
194
|
|
|
195 static DOESNT_RETURN
|
|
|
196 syntax_error (CONST char *string)
|
|
|
197 {
|
|
|
198 signal_error (Qinvalid_read_syntax,
|
|
|
199 list1 (build_translated_string (string)));
|
|
|
200 }
|
|
|
201
|
|
|
202 static Lisp_Object
|
|
|
203 continuable_syntax_error (CONST char *string)
|
|
|
204 {
|
|
|
205 return Fsignal (Qinvalid_read_syntax,
|
|
|
206 list1 (build_translated_string (string)));
|
|
|
207 }
|
|
|
208
|
|
|
209
|
|
|
210 /* Handle unreading and rereading of characters. */
|
|
|
211 static Emchar
|
|
|
212 readchar (Lisp_Object readcharfun)
|
|
|
213 {
|
|
|
214 /* This function can GC */
|
|
|
215
|
|
|
216 if (BUFFERP (readcharfun))
|
|
|
217 {
|
|
|
218 Emchar c;
|
|
|
219 struct buffer *b = XBUFFER (readcharfun);
|
|
|
220
|
|
|
221 if (!BUFFER_LIVE_P (b))
|
|
|
222 error ("Reading from killed buffer");
|
|
|
223
|
|
|
224 if (BUF_PT (b) >= BUF_ZV (b))
|
|
|
225 return -1;
|
|
|
226 c = BUF_FETCH_CHAR (b, BUF_PT (b));
|
|
|
227 BUF_SET_PT (b, BUF_PT (b) + 1);
|
|
|
228
|
|
|
229 return c;
|
|
|
230 }
|
|
|
231 else if (LSTREAMP (readcharfun))
|
|
|
232 {
|
|
|
233 return Lstream_get_emchar (XLSTREAM (readcharfun));
|
|
|
234 }
|
|
|
235 else if (MARKERP (readcharfun))
|
|
|
236 {
|
|
|
237 Emchar c;
|
|
|
238 Bufpos mpos = marker_position (readcharfun);
|
|
|
239 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
|
|
|
240
|
|
|
241 if (mpos >= BUF_ZV (inbuffer))
|
|
|
242 return -1;
|
|
|
243 c = BUF_FETCH_CHAR (inbuffer, mpos);
|
|
|
244 set_marker_position (readcharfun, mpos + 1);
|
|
|
245 return c;
|
|
|
246 }
|
|
|
247 else
|
|
|
248 {
|
|
|
249 Lisp_Object tem = call0 (readcharfun);
|
|
|
250
|
|
|
251 if (!CHAR_OR_CHAR_INTP (tem))
|
|
|
252 return -1;
|
|
|
253 return XCHAR_OR_CHAR_INT (tem);
|
|
|
254 }
|
|
|
255 }
|
|
|
256
|
|
|
257 /* Unread the character C in the way appropriate for the stream READCHARFUN.
|
|
|
258 If the stream is a user function, call it with the char as argument. */
|
|
|
259
|
|
|
260 static void
|
|
|
261 unreadchar (Lisp_Object readcharfun, Emchar c)
|
|
|
262 {
|
|
|
263 if (c == -1)
|
|
|
264 /* Don't back up the pointer if we're unreading the end-of-input mark,
|
|
|
265 since readchar didn't advance it when we read it. */
|
|
|
266 ;
|
|
|
267 else if (BUFFERP (readcharfun))
|
|
|
268 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
|
|
|
269 else if (LSTREAMP (readcharfun))
|
|
|
270 {
|
|
|
271 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
|
|
|
272 }
|
|
|
273 else if (MARKERP (readcharfun))
|
|
|
274 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
|
|
|
275 else
|
|
|
276 call1 (readcharfun, make_char (c));
|
|
|
277 }
|
|
|
278
|
|
|
279 static Lisp_Object read0 (Lisp_Object readcharfun);
|
|
|
280 static Lisp_Object read1 (Lisp_Object readcharfun);
|
|
|
281 /* allow_dotted_lists means that something like (foo bar . baz)
|
|
|
282 is acceptable. If -1, means check for starting with defun
|
|
|
283 and make structure pure. (not implemented, probably for very
|
|
|
284 good reasons)
|
|
|
285 */
|
|
|
286 /*
|
|
|
287 If check_for_doc_references, look for (#$ . INT) doc references
|
|
|
288 in the list and record if load_force_doc_strings is non-zero.
|
|
|
289 (Such doc references will be destroyed during the loadup phase
|
|
|
290 by replacing with Qzero, because Snarf-documentation will fill
|
|
|
291 them in again.)
|
|
|
292
|
|
|
293 WARNING: If you set this, you sure as hell better not call
|
|
|
294 free_list() on the returned list here. */
|
|
|
295
|
|
|
296 static Lisp_Object read_list (Lisp_Object readcharfun,
|
|
|
297 Emchar terminator,
|
|
|
298 int allow_dotted_lists,
|
|
|
299 int check_for_doc_references);
|
|
|
300
|
|
|
301 /* get a character from the tty */
|
|
|
302
|
|
|
303 #ifdef standalone /* This primitive is normally not defined */
|
|
|
304
|
|
|
305 #define kludge DEFUN /* to keep this away from make-docfile... */
|
|
|
306 kludge ("read-char", Fread_char, Sread_char, 0, 0, 0, "") ()
|
|
|
307 {
|
|
|
308 return getchar ();
|
|
|
309 }
|
|
|
310 #undef kludge
|
|
|
311 #endif /* standalone */
|
|
|
312
|
|
|
313
|
|
|
314
|
|
|
315 static void readevalloop (Lisp_Object readcharfun,
|
|
|
316 Lisp_Object sourcefile,
|
|
|
317 Lisp_Object (*evalfun) (Lisp_Object),
|
|
|
318 int printflag);
|
|
|
319
|
|
|
320 static Lisp_Object
|
|
|
321 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
|
|
|
322 {
|
|
|
323 Lstream_close (XLSTREAM (stream));
|
|
|
324 if (--load_in_progress < 0)
|
|
|
325 load_in_progress = 0;
|
|
|
326 return Qnil;
|
|
|
327 }
|
|
|
328
|
|
|
329 static Lisp_Object
|
|
|
330 load_descriptor_unwind (Lisp_Object oldlist)
|
|
|
331 {
|
|
|
332 Vload_descriptor_list = oldlist;
|
|
|
333 return Qnil;
|
|
|
334 }
|
|
|
335
|
|
|
336 static Lisp_Object
|
|
|
337 load_file_name_internal_unwind (Lisp_Object oldval)
|
|
|
338 {
|
|
|
339 Vload_file_name_internal = oldval;
|
|
|
340 return Qnil;
|
|
|
341 }
|
|
|
342
|
|
|
343 static Lisp_Object
|
|
|
344 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
|
|
|
345 {
|
|
|
346 Vload_file_name_internal_the_purecopy = oldval;
|
|
|
347 return Qnil;
|
|
|
348 }
|
|
|
349
|
|
|
350 static Lisp_Object
|
|
|
351 pas_de_lache_ici (int fd, Lisp_Object victim)
|
|
|
352 {
|
|
|
353 Lisp_Object tem;
|
|
|
354 EMACS_INT pos;
|
|
|
355
|
|
|
356 if (!INTP (XCDR (victim)))
|
|
|
357 signal_simple_error ("Bogus doc string reference", victim);
|
|
|
358 pos = XINT (XCDR (victim));
|
|
|
359 if (pos < 0)
|
|
|
360 pos = -pos; /* kludge to mark a user variable */
|
|
|
361 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
|
|
|
362 if (!STRINGP (tem))
|
|
|
363 signal_error (Qerror, tem);
|
|
|
364 return tem;
|
|
|
365 }
|
|
|
366
|
|
|
367 static Lisp_Object
|
|
|
368 load_force_doc_string_unwind (Lisp_Object oldlist)
|
|
|
369 {
|
|
|
370 struct gcpro gcpro1;
|
|
|
371 Lisp_Object list = Vload_force_doc_string_list;
|
|
|
372 Lisp_Object tail;
|
|
|
373 int fd = XINT (XCAR (Vload_descriptor_list));
|
|
|
374 /* NOTE: If purify_flag is true, we're in-place modifying objects that
|
|
|
375 may be in purespace (and if not, they will be). Therefore, we have
|
|
|
376 to be VERY careful to make sure that all objects that we create
|
|
|
377 are purecopied -- objects in purespace are not marked for GC, and
|
|
|
378 if we leave any impure objects inside of pure ones, we're really
|
|
|
379 screwed. */
|
|
|
380
|
|
|
381 GCPRO1 (list);
|
|
|
382 /* restore the old value first just in case an error occurs. */
|
|
|
383 Vload_force_doc_string_list = oldlist;
|
|
|
384
|
|
|
385 LIST_LOOP (tail, list)
|
|
|
386 {
|
|
|
387 Lisp_Object john = Fcar (tail);
|
|
|
388 if (CONSP (john))
|
|
|
389 {
|
|
|
390 assert (CONSP (XCAR (john)));
|
|
|
391 assert (!purify_flag); /* should have been handled in read_list() */
|
|
|
392 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
|
|
|
393 }
|
|
|
394 else
|
|
|
395 {
|
|
|
396 Lisp_Object doc;
|
|
|
397
|
|
|
398 assert (COMPILED_FUNCTIONP (john));
|
|
|
399 if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes))
|
|
|
400 {
|
|
|
401 struct gcpro ngcpro1;
|
|
|
402 Lisp_Object juan = (pas_de_lache_ici
|
|
|
403 (fd, XCOMPILED_FUNCTION (john)->bytecodes));
|
|
|
404 Lisp_Object ivan;
|
|
|
405
|
|
|
406 NGCPRO1 (juan);
|
|
|
407 ivan = Fread (juan);
|
|
|
408 if (!CONSP (ivan))
|
|
|
409 signal_simple_error ("invalid lazy-loaded byte code", ivan);
|
|
|
410 /* Remember to purecopy; see above. */
|
|
|
411 XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan));
|
|
|
412 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
|
|
|
413 NUNGCPRO;
|
|
|
414 }
|
|
|
415 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
|
|
|
416 if (CONSP (doc))
|
|
|
417 {
|
|
|
418 assert (!purify_flag); /* should have been handled in
|
|
|
419 read_compiled_function() */
|
|
|
420 doc = pas_de_lache_ici (fd, doc);
|
|
|
421 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
|
|
|
422 doc);
|
|
|
423 }
|
|
|
424 }
|
|
|
425 }
|
|
|
426
|
|
|
427 if (!NILP (list))
|
|
|
428 free_list (list);
|
|
|
429
|
|
|
430 UNGCPRO;
|
|
|
431 return Qnil;
|
|
|
432 }
|
|
|
433
|
|
|
434 /* Close all descriptors in use for Fload_internal.
|
|
|
435 This is used when starting a subprocess. */
|
|
|
436
|
|
|
437 void
|
|
|
438 close_load_descs (void)
|
|
|
439 {
|
|
|
440 Lisp_Object tail;
|
|
|
441 LIST_LOOP (tail, Vload_descriptor_list)
|
|
|
442 close (XINT (XCAR (tail)));
|
|
|
443 }
|
|
|
444
|
|
|
445 #ifdef I18N3
|
|
|
446 Lisp_Object Vfile_domain;
|
|
|
447
|
|
|
448 Lisp_Object
|
|
|
449 restore_file_domain (Lisp_Object val)
|
|
|
450 {
|
|
|
451 Vfile_domain = val;
|
|
|
452 return Qnil;
|
|
|
453 }
|
|
|
454 #endif /* I18N3 */
|
|
|
455
|
|
|
456 DEFUN ("load-internal", Fload_internal, Sload_internal, 1, 4, 0 /*
|
|
|
457 Execute a file of Lisp code named FILE.
|
|
|
458 First try FILE with `.elc' appended, then try with `.el',
|
|
|
459 then try FILE unmodified.
|
|
|
460 This function searches the directories in `load-path'.
|
|
|
461 If optional second arg NOERROR is non-nil,
|
|
|
462 report no error if FILE doesn't exist.
|
|
|
463 Print messages at start and end of loading unless
|
|
|
464 optional third arg NOMESSAGE is non-nil (ignored in -batch mode).
|
|
|
465 If optional fourth arg NOSUFFIX is non-nil, don't try adding
|
|
|
466 suffixes `.elc' or `.el' to the specified name FILE.
|
|
|
467 Return t if file exists.
|
|
|
468 */ )
|
|
|
469 (file, no_error, nomessage, nosuffix)
|
|
|
470 Lisp_Object file, no_error, nomessage, nosuffix;
|
|
|
471 {
|
|
|
472 /* This function can GC */
|
|
|
473 int fd = -1;
|
|
|
474 int speccount = specpdl_depth ();
|
|
|
475 int source_only = 0;
|
|
|
476 Lisp_Object newer = Qnil;
|
|
|
477 Lisp_Object handler = Qnil;
|
|
|
478 Lisp_Object found = Qnil;
|
|
|
479 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
480 #ifdef DEBUG_XEMACS
|
|
|
481 int pure_usage = 0;
|
|
|
482 #endif
|
|
|
483 #ifdef DOS_NT
|
|
|
484 int dosmode = O_TEXT;
|
|
|
485 #endif /* DOS_NT */
|
|
|
486 GCPRO3 (file, newer, found);
|
|
|
487
|
|
|
488 CHECK_STRING (file);
|
|
|
489
|
|
|
490 #ifdef DEBUG_XEMACS
|
|
|
491 if (purify_flag && noninteractive)
|
|
|
492 pure_usage = purespace_usage ();
|
|
|
493 #endif
|
|
|
494
|
|
|
495 /* If file name is magic, call the handler. */
|
|
|
496 handler = Ffind_file_name_handler (file, Qload);
|
|
|
497 if (!NILP (handler))
|
|
|
498 {
|
|
|
499 RETURN_UNGCPRO (call5 (handler, Qload, file, no_error, nomessage,
|
|
|
500 nosuffix));
|
|
|
501 }
|
|
|
502
|
|
|
503 /* Do this after the handler to avoid
|
|
|
504 the need to gcpro noerror, nomessage and nosuffix.
|
|
|
505 (Below here, we care only whether they are nil or not.) */
|
|
|
506 file = Fsubstitute_in_file_name (file);
|
|
|
507
|
|
|
508 /* Avoid weird lossage with null string as arg,
|
|
|
509 since it would try to load a directory as a Lisp file.
|
|
|
510 Unix truly sucks. */
|
|
|
511 if (string_length (XSTRING (file)) > 0)
|
|
|
512 {
|
|
|
513 char *foundstr;
|
|
|
514 int foundlen;
|
|
|
515
|
|
|
516 fd = locate_file (Vload_path, file,
|
|
|
517 ((!NILP (nosuffix)) ? "" :
|
|
|
518 load_ignore_elc_files ? ".el:" :
|
|
|
519 ".elc:.el:"),
|
|
|
520 &found,
|
|
|
521 -1);
|
|
|
522
|
|
|
523 if (fd < 0)
|
|
|
524 {
|
|
|
525 if (NILP (no_error))
|
|
|
526 signal_file_error ("Cannot open load file", file);
|
|
|
527 else
|
|
|
528 {
|
|
|
529 UNGCPRO;
|
|
|
530 return Qnil;
|
|
|
531 }
|
|
|
532 }
|
|
|
533
|
|
|
534 foundstr = (char *) alloca (string_length (XSTRING (found)) + 1);
|
|
|
535 strcpy (foundstr, (char *) string_data (XSTRING (found)));
|
|
|
536 foundlen = strlen (foundstr);
|
|
|
537
|
|
|
538 /* The omniscient JWZ thinks this is worthless, but I beg to
|
|
|
539 differ. --ben */
|
|
|
540 if (load_ignore_elc_files)
|
|
|
541 {
|
|
|
542 newer = Ffile_name_nondirectory (found);
|
|
|
543 }
|
|
|
544 else if (load_warn_when_source_newer &&
|
|
|
545 !memcmp (".elc", foundstr + foundlen - 4, 4))
|
|
|
546 {
|
|
|
547 struct stat s1, s2;
|
|
|
548 if (! fstat (fd, &s1)) /* can't fail, right? */
|
|
|
549 {
|
|
|
550 int result;
|
|
|
551 /* temporarily hack the 'c' off the end of the filename */
|
|
|
552 foundstr[foundlen - 1] = '\0';
|
|
|
553 result = stat (foundstr, &s2);
|
|
|
554 if (result >= 0 &&
|
|
|
555 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
|
|
|
556 {
|
|
|
557 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
|
|
|
558 foundlen - 1);
|
|
|
559 struct gcpro nngcpro1;
|
|
|
560 NNGCPRO1 (newer_name);
|
|
|
561 newer = Ffile_name_nondirectory (newer_name);
|
|
|
562 NNUNGCPRO;
|
|
|
563 }
|
|
|
564 /* put the 'c' back on (kludge-o-rama) */
|
|
|
565 foundstr[foundlen - 1] = 'c';
|
|
|
566 }
|
|
|
567 }
|
|
|
568 else if (load_warn_when_source_only &&
|
|
|
569 /* `found' ends in ".el" */
|
|
|
570 !memcmp (".el", foundstr + foundlen - 3, 3) &&
|
|
|
571 /* `file' does not end in ".el" */
|
|
|
572 memcmp (".el",
|
|
|
573 string_data (XSTRING (file)) +
|
|
|
574 string_length (XSTRING (file)) - 3,
|
|
|
575 3))
|
|
|
576 {
|
|
|
577 source_only = 1;
|
|
|
578 }
|
|
|
579 }
|
|
|
580
|
|
|
581 #ifdef DOS_NT
|
|
|
582 /* The file was opened as binary, because that's what we'll
|
|
|
583 encounter most of the time. If we're loading a .el, we need
|
|
|
584 to reopen it in text mode. */
|
|
|
585 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
|
|
|
586 ;
|
|
|
587 else
|
|
|
588 fd = open (foundstr, O_RDONLY | O_TEXT);
|
|
|
589 #endif /* not DOS_NT */
|
|
|
590
|
|
|
591 if (load_ignore_elc_files)
|
|
|
592 {
|
|
|
593 if (noninteractive || NILP (nomessage))
|
|
|
594 message ("Loading %s...", string_data (XSTRING (newer)));
|
|
|
595 }
|
|
|
596 else if (!NILP (newer))
|
|
|
597 {
|
|
|
598 message ("Loading %s... (file %s is newer)",
|
|
|
599 string_data (XSTRING (file)),
|
|
|
600 string_data (XSTRING (newer)));
|
|
|
601 nomessage = Qnil; /* we printed the first one, so print "done" too */
|
|
|
602 }
|
|
|
603 else if (source_only)
|
|
|
604 {
|
|
|
605 message ("Loading %s... (file %s.elc does not exist)",
|
|
|
606 string_data (XSTRING (file)),
|
|
|
607 string_data (XSTRING (Ffile_name_nondirectory (file))));
|
|
|
608 nomessage = Qnil;
|
|
|
609 }
|
|
|
610 else if (noninteractive || NILP (nomessage))
|
|
|
611 message ("Loading %s...", string_data (XSTRING (file)));
|
|
|
612
|
|
|
613 {
|
|
|
614 /* Lisp_Object's must be malloc'ed, not stack-allocated */
|
|
|
615 Lisp_Object lispstream = Qnil;
|
|
|
616 CONST int block_size = 8192;
|
|
|
617 struct gcpro ngcpro1;
|
|
|
618
|
|
|
619 NGCPRO1 (lispstream);
|
|
|
620 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
|
|
|
621 /* 64K is used for normal files; 8K should be OK here because Lisp
|
|
|
622 files aren't really all that big. */
|
|
|
623 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
|
|
|
624 block_size);
|
|
|
625
|
|
|
626 /* NOTE: Order of these is very important. Don't rearrange them. */
|
|
|
627 record_unwind_protect (load_unwind, lispstream);
|
|
|
628 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
|
|
|
629 record_unwind_protect (load_file_name_internal_unwind,
|
|
|
630 Vload_file_name_internal);
|
|
|
631 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
|
|
|
632 Vload_file_name_internal_the_purecopy);
|
|
|
633 record_unwind_protect (load_force_doc_string_unwind,
|
|
|
634 Vload_force_doc_string_list);
|
|
|
635 Vload_file_name_internal = found;
|
|
|
636 Vload_file_name_internal_the_purecopy = Qnil;
|
|
|
637 specbind (Qload_file_name, found);
|
|
|
638 Vload_descriptor_list
|
|
|
639 = Fcons (make_int (fd), Vload_descriptor_list);
|
|
|
640 Vload_force_doc_string_list = Qnil;
|
|
|
641 #ifdef I18N3
|
|
|
642 record_unwind_protect (restore_file_domain, Vfile_domain);
|
|
|
643 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
|
|
|
644 #endif
|
|
|
645 load_in_progress++;
|
|
|
646 readevalloop (lispstream, file, Feval, 0);
|
|
|
647 unbind_to (speccount, Qnil);
|
|
|
648
|
|
|
649 NUNGCPRO;
|
|
|
650 }
|
|
|
651
|
|
|
652 {
|
|
|
653 Lisp_Object tem;
|
|
|
654 /* #### Disgusting kludge */
|
|
|
655 /* Run any load-hooks for this file. */
|
|
|
656 tem = Fassoc (file, Vafter_load_alist);
|
|
|
657 if (!NILP (tem))
|
|
|
658 {
|
|
|
659 struct gcpro ngcpro1;
|
|
|
660
|
|
|
661 NGCPRO1 (tem);
|
|
|
662 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
|
|
|
663 tem = Fcons (Qprogn, Fcdr (tem));
|
|
|
664 Feval (tem);
|
|
|
665 NUNGCPRO;
|
|
|
666 }
|
|
|
667 }
|
|
|
668
|
|
|
669 #ifdef DEBUG_XEMACS
|
|
|
670 if (noninteractive && purify_flag)
|
|
|
671 {
|
|
|
672 int this_pure_usage = purespace_usage () - pure_usage;
|
|
|
673 message_append (" (%d)", this_pure_usage);
|
|
|
674 }
|
|
|
675 #endif
|
|
|
676
|
|
|
677 if (noninteractive || !NILP (nomessage))
|
|
|
678 ;
|
|
|
679 else if (!NILP (newer))
|
|
|
680 message ("Loading %s...done (file %s is newer)",
|
|
|
681 string_data (XSTRING (file)),
|
|
|
682 string_data (XSTRING (newer)));
|
|
|
683 else
|
|
|
684 message ("Loading %s...done", string_data (XSTRING (file)));
|
|
|
685
|
|
|
686 UNGCPRO;
|
|
|
687 return Qt;
|
|
|
688 }
|
|
|
689
|
|
|
690
|
|
|
691 #if 0 /* FSFmacs */
|
|
|
692 /* not used */
|
|
|
693 static int
|
|
|
694 complete_filename_p (Lisp_Object pathname)
|
|
|
695 {
|
|
|
696 REGISTER unsigned char *s = string_data (XSTRING (pathname));
|
|
|
697 return (IS_DIRECTORY_SEP (s[0])
|
|
|
698 || (string_length (XSTRING (pathname)) > 2
|
|
|
699 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
|
|
|
700 #ifdef ALTOS
|
|
|
701 || *s == '@'
|
|
|
702 #endif
|
|
|
703 #ifdef VMS
|
|
|
704 || strchr (s, ':')
|
|
|
705 #endif /* VMS */
|
|
|
706 );
|
|
|
707 }
|
|
|
708 #endif /* 0 */
|
|
|
709
|
|
|
710 DEFUN ("locate-file", Flocate_file, Slocate_file, 2, 4, 0 /*
|
|
|
711 Search for FILENAME through PATH-LIST, expanded by one of the optional
|
|
|
712 SUFFIXES (string of suffixes separated by \":\"s), checking for access
|
|
|
713 MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
|
|
|
714
|
|
|
715 `locate-file' keeps hash tables of the directories it searches through,
|
|
|
716 in order to speed things up. It tries valiantly to not get confused in
|
|
|
717 the face of a changing and unpredictable environment, but can occasionally
|
|
|
718 get tripped up. In this case, you will have to call
|
|
|
719 `locate-file-clear-hashing' to get it back on track. See that function
|
|
|
720 for details.
|
|
|
721 */ )
|
|
|
722 (filename, path_list, suffixes, mode)
|
|
|
723 Lisp_Object filename, path_list, suffixes, mode;
|
|
|
724 {
|
|
|
725 /* This function can GC */
|
|
|
726 Lisp_Object tp;
|
|
|
727
|
|
|
728 CHECK_STRING (filename);
|
|
|
729 if (!NILP (suffixes))
|
|
|
730 {
|
|
|
731 CHECK_STRING (suffixes);
|
|
|
732 }
|
|
|
733 if (!(NILP (mode) || (INTP (mode) && XINT (mode) >= 0)))
|
|
|
734 mode = wrong_type_argument (Qnatnump, mode);
|
|
|
735 locate_file (path_list, filename,
|
|
|
736 ((NILP (suffixes)) ? "" :
|
|
|
737 (char *) (string_data (XSTRING (suffixes)))),
|
|
|
738 &tp, (NILP (mode) ? R_OK : XINT (mode)));
|
|
|
739 return tp;
|
|
|
740 }
|
|
|
741
|
|
|
742 /* recalculate the hash table for the given string */
|
|
|
743
|
|
|
744 static Lisp_Object
|
|
|
745 locate_file_refresh_hashing (Lisp_Object str)
|
|
|
746 {
|
|
|
747 Lisp_Object hash =
|
|
|
748 make_directory_hash_table ((char *) string_data (XSTRING (str)));
|
|
|
749 Fput (str, Qlocate_file_hash_table, hash);
|
|
|
750 return hash;
|
|
|
751 }
|
|
|
752
|
|
|
753 /* find the hash table for the given string, recalculating if necessary */
|
|
|
754
|
|
|
755 static Lisp_Object
|
|
|
756 locate_file_find_directory_hash_table (Lisp_Object str)
|
|
|
757 {
|
|
|
758 Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
|
|
|
759 if (NILP (Fhashtablep (hash)))
|
|
|
760 return locate_file_refresh_hashing (str);
|
|
|
761 return hash;
|
|
|
762 }
|
|
|
763
|
|
|
764 /* look for STR in PATH, optionally adding suffixes in SUFFIX */
|
|
|
765
|
|
|
766 static int
|
|
|
767 locate_file_in_directory (Lisp_Object path, Lisp_Object str,
|
|
|
768 CONST char *suffix, Lisp_Object *storeptr,
|
|
|
769 int mode)
|
|
|
770 {
|
|
|
771 /* This function can GC */
|
|
|
772 int fd;
|
|
|
773 int fn_size = 100;
|
|
|
774 char buf[100];
|
|
|
775 char *fn = buf;
|
|
|
776 int want_size;
|
|
|
777 struct stat st;
|
|
|
778 Lisp_Object filename = Qnil;
|
|
|
779 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
780 CONST char *nsuffix;
|
|
|
781
|
|
|
782 GCPRO3 (path, str, filename);
|
|
|
783
|
|
|
784 filename = Fexpand_file_name (str, path);
|
|
|
785 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
|
|
|
786 /* If there are non-absolute elts in PATH (eg ".") */
|
|
|
787 /* Of course, this could conceivably lose if luser sets
|
|
|
788 default-directory to be something non-absolute ... */
|
|
|
789 {
|
|
|
790 if (NILP (filename))
|
|
|
791 /* NIL means current dirctory */
|
|
|
792 filename = current_buffer->directory;
|
|
|
793 else
|
|
|
794 filename = Fexpand_file_name (filename,
|
|
|
795 current_buffer->directory);
|
|
|
796 if (NILP (Ffile_name_absolute_p (filename)))
|
|
|
797 {
|
|
|
798 /* Give up on this path element! */
|
|
|
799 UNGCPRO;
|
|
|
800 return -1;
|
|
|
801 }
|
|
|
802 }
|
|
|
803 /* Calculate maximum size of any filename made from
|
|
|
804 this path element/specified file name and any possible suffix. */
|
|
|
805 want_size = strlen (suffix) +
|
|
|
806 string_length (XSTRING (filename)) + 1;
|
|
|
807 if (fn_size < want_size)
|
|
|
808 fn = (char *) alloca (fn_size = 100 + want_size);
|
|
|
809
|
|
|
810 nsuffix = suffix;
|
|
|
811
|
|
|
812 /* Loop over suffixes. */
|
|
|
813 while (1)
|
|
|
814 {
|
|
|
815 char *esuffix = (char *) strchr (nsuffix, ':');
|
|
|
816 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
|
|
|
817
|
|
|
818 /* Concatenate path element/specified name with the suffix. */
|
|
|
819 strncpy (fn, (char *) string_data (XSTRING (filename)),
|
|
|
820 string_length (XSTRING (filename)));
|
|
|
821 fn[string_length (XSTRING (filename))] = 0;
|
|
|
822 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
|
|
|
823 strncat (fn, nsuffix, lsuffix);
|
|
|
824
|
|
|
825 /* Ignore file if it's a directory. */
|
|
|
826 if (stat (fn, &st) >= 0
|
|
|
827 && (st.st_mode & S_IFMT) != S_IFDIR)
|
|
|
828 {
|
|
|
829 /* Check that we can access or open it. */
|
|
|
830 if (mode >= 0)
|
|
|
831 fd = access (fn, mode);
|
|
|
832 else
|
|
|
833 #ifdef DOS_NT
|
|
|
834 fd = open (fn, O_RDONLY | O_BINARY, 0);
|
|
|
835 #else
|
|
|
836 fd = open (fn, O_RDONLY, 0);
|
|
|
837 #endif
|
|
|
838
|
|
|
839 if (fd >= 0)
|
|
|
840 {
|
|
|
841 /* We succeeded; return this descriptor and filename. */
|
|
|
842 if (storeptr)
|
|
|
843 *storeptr = build_string (fn);
|
|
|
844 UNGCPRO;
|
|
|
845
|
|
|
846 /* If we actually opened the file, set close-on-exec flag
|
|
|
847 on the new descriptor so that subprocesses can't whack
|
|
|
848 at it. */
|
|
|
849 if (mode < 0)
|
|
|
850 (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
|
|
|
851
|
|
|
852 return fd;
|
|
|
853 }
|
|
|
854 }
|
|
|
855
|
|
|
856 /* Advance to next suffix. */
|
|
|
857 if (esuffix == 0)
|
|
|
858 break;
|
|
|
859 nsuffix += lsuffix + 1;
|
|
|
860 }
|
|
|
861
|
|
|
862 UNGCPRO;
|
|
|
863 return -1;
|
|
|
864 }
|
|
|
865
|
|
|
866 /* do the same as locate_file() but don't use any hash tables. */
|
|
|
867
|
|
|
868 static int
|
|
|
869 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
|
|
|
870 CONST char *suffix, Lisp_Object *storeptr,
|
|
|
871 int mode)
|
|
|
872 {
|
|
|
873 /* This function can GC */
|
|
|
874 int absolute;
|
|
|
875 struct gcpro gcpro1;
|
|
|
876
|
|
|
877 /* is this necessary? */
|
|
|
878 GCPRO1 (path);
|
|
|
879
|
|
|
880 absolute = !NILP (Ffile_name_absolute_p (str));
|
|
|
881
|
|
|
882 for (; !NILP (path); path = Fcdr (path))
|
|
|
883 {
|
|
|
884 int val = locate_file_in_directory (Fcar (path), str, suffix,
|
|
|
885 storeptr, mode);
|
|
|
886 if (val >= 0)
|
|
|
887 {
|
|
|
888 UNGCPRO;
|
|
|
889 return val;
|
|
|
890 }
|
|
|
891 if (absolute)
|
|
|
892 break;
|
|
|
893 }
|
|
|
894
|
|
|
895 UNGCPRO;
|
|
|
896 return -1;
|
|
|
897 }
|
|
|
898
|
|
|
899 /* Construct a list of all files to search for. */
|
|
|
900
|
|
|
901 static Lisp_Object
|
|
|
902 locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
|
|
|
903 {
|
|
|
904 int want_size;
|
|
|
905 int fn_size = 100;
|
|
|
906 char buf[100];
|
|
|
907 char *fn = buf;
|
|
|
908 CONST char *nsuffix;
|
|
|
909 Lisp_Object suffixtab = Qnil;
|
|
|
910
|
|
|
911 /* Calculate maximum size of any filename made from
|
|
|
912 this path element/specified file name and any possible suffix. */
|
|
|
913 want_size = strlen (suffix) + string_length (XSTRING (str)) + 1;
|
|
|
914 if (fn_size < want_size)
|
|
|
915 fn = (char *) alloca (fn_size = 100 + want_size);
|
|
|
916
|
|
|
917 nsuffix = suffix;
|
|
|
918
|
|
|
919 while (1)
|
|
|
920 {
|
|
|
921 char *esuffix = (char *) strchr (nsuffix, ':');
|
|
|
922 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
|
|
|
923
|
|
|
924 /* Concatenate path element/specified name with the suffix. */
|
|
|
925 strncpy (fn, (char *) string_data (XSTRING (str)),
|
|
|
926 string_length (XSTRING (str)));
|
|
|
927 fn[string_length (XSTRING (str))] = 0;
|
|
|
928 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
|
|
|
929 strncat (fn, nsuffix, lsuffix);
|
|
|
930
|
|
|
931 suffixtab = Fcons (build_string (fn), suffixtab);
|
|
|
932 /* Advance to next suffix. */
|
|
|
933 if (esuffix == 0)
|
|
|
934 break;
|
|
|
935 nsuffix += lsuffix + 1;
|
|
|
936 }
|
|
|
937 return Fnreverse (suffixtab);
|
|
|
938 }
|
|
|
939
|
|
|
940 /* Search for a file whose name is STR, looking in directories
|
|
|
941 in the Lisp list PATH, and trying suffixes from SUFFIX.
|
|
|
942 SUFFIX is a string containing possible suffixes separated by colons.
|
|
|
943 On success, returns a file descriptor. On failure, returns -1.
|
|
|
944
|
|
|
945 MODE nonnegative means don't open the files,
|
|
|
946 just look for one for which access(file,MODE) succeeds. In this case,
|
|
|
947 returns 1 on success.
|
|
|
948
|
|
|
949 If STOREPTR is nonzero, it points to a slot where the name of
|
|
|
950 the file actually found should be stored as a Lisp string.
|
|
|
951 Nil is stored there on failure.
|
|
|
952
|
|
|
953 Called openp() in FSFmacs. */
|
|
|
954
|
|
|
955 int
|
|
|
956 locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
|
|
|
957 Lisp_Object *storeptr, int mode)
|
|
|
958 {
|
|
|
959 /* This function can GC */
|
|
|
960 Lisp_Object suffixtab = Qnil;
|
|
|
961 Lisp_Object pathtail;
|
|
|
962 int val;
|
|
|
963 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
|
964
|
|
|
965 if (storeptr)
|
|
|
966 *storeptr = Qnil;
|
|
|
967
|
|
|
968 /* if this filename has directory components, it's too complicated
|
|
|
969 to try and use the hash tables. */
|
|
|
970 if (!NILP (Ffile_name_directory (str)))
|
|
|
971 return locate_file_without_hash (path, str, suffix, storeptr,
|
|
|
972 mode);
|
|
|
973
|
|
|
974 /* Is it really necessary to gcpro path and str? It shouldn't be
|
|
|
975 unless some caller has fucked up. */
|
|
|
976 GCPRO3 (path, str, suffixtab);
|
|
|
977
|
|
|
978 suffixtab = locate_file_construct_suffixed_files (str, suffix);
|
|
|
979
|
|
|
980 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
|
|
|
981 {
|
|
|
982 Lisp_Object pathel = Fcar (pathtail);
|
|
|
983 Lisp_Object hashtab;
|
|
|
984 Lisp_Object tail;
|
|
|
985 int found;
|
|
|
986
|
|
|
987 /* If this path element is relative, we have to look by hand.
|
|
|
988 Can't set string property in a pure string. */
|
|
|
989 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
|
|
|
990 purified (pathel))
|
|
|
991 {
|
|
|
992 val = locate_file_in_directory (pathel, str, suffix, storeptr,
|
|
|
993 mode);
|
|
|
994 if (val >= 0)
|
|
|
995 {
|
|
|
996 UNGCPRO;
|
|
|
997 return val;
|
|
|
998 }
|
|
|
999 continue;
|
|
|
1000 }
|
|
|
1001
|
|
|
1002 hashtab = locate_file_find_directory_hash_table (pathel);
|
|
|
1003
|
|
|
1004 /* Loop over suffixes. */
|
|
|
1005 for (tail = suffixtab, found = 0; !NILP (tail) && !found;
|
|
|
1006 tail = Fcdr (tail))
|
|
|
1007 {
|
|
|
1008 if (!NILP (Fgethash (Fcar (tail), hashtab, Qnil)))
|
|
|
1009 found = 1;
|
|
|
1010 }
|
|
|
1011
|
|
|
1012 if (found)
|
|
|
1013 {
|
|
|
1014 /* This is a likely candidate. Look by hand in this directory
|
|
|
1015 so we don't get thrown off if someone byte-compiles a file. */
|
|
|
1016 val = locate_file_in_directory (pathel, str, suffix, storeptr,
|
|
|
1017 mode);
|
|
|
1018 if (val >= 0)
|
|
|
1019 {
|
|
|
1020 UNGCPRO;
|
|
|
1021 return val;
|
|
|
1022 }
|
|
|
1023
|
|
|
1024 /* Hmm ... the file isn't actually there. (Or possibly it's
|
|
|
1025 a directory ...) So refresh our hashing. */
|
|
|
1026 locate_file_refresh_hashing (pathel);
|
|
|
1027 }
|
|
|
1028 }
|
|
|
1029
|
|
|
1030 /* File is probably not there, but check the hard way just in case. */
|
|
|
1031 val = locate_file_without_hash (path, str, suffix, storeptr,
|
|
|
1032 mode);
|
|
|
1033 if (val >= 0)
|
|
|
1034 {
|
|
|
1035 /* Sneaky user added a file without telling us. */
|
|
|
1036 Flocate_file_clear_hashing (path);
|
|
|
1037 }
|
|
|
1038
|
|
|
1039 UNGCPRO;
|
|
|
1040 return val;
|
|
|
1041 }
|
|
|
1042
|
|
|
1043 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing,
|
|
|
1044 Slocate_file_clear_hashing, 1, 1, 0 /*
|
|
|
1045 Clear the hash records for the specified list of directories.
|
|
|
1046 `locate-file' uses a hashing scheme to speed lookup, and will correctly
|
|
|
1047 track the following environmental changes:
|
|
|
1048
|
|
|
1049 -- changes of any sort to the list of directories to be searched.
|
|
|
1050 -- addition and deletion of non-shadowing files (see below) from the
|
|
|
1051 directories in the list.
|
|
|
1052 -- byte-compilation of a .el file into a .elc file.
|
|
|
1053
|
|
|
1054 `locate-file' will primarily get confused if you add a file that shadows
|
|
|
1055 (i.e. has the same name as) another file further down in the directory list.
|
|
|
1056 In this case, you must call `locate-file-clear-hashing'.
|
|
|
1057 */ )
|
|
|
1058 (path)
|
|
|
1059 Lisp_Object path;
|
|
|
1060 {
|
|
|
1061 Lisp_Object pathtail;
|
|
|
1062
|
|
|
1063 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
|
|
|
1064 {
|
|
|
1065 Lisp_Object pathel = Fcar (pathtail);
|
|
|
1066 if (!purified (pathel))
|
|
|
1067 Fput (pathel, Qlocate_file_hash_table, Qnil);
|
|
|
1068 }
|
|
|
1069 return Qnil;
|
|
|
1070 }
|
|
|
1071
|
|
|
1072 #ifdef LOADHIST
|
|
|
1073
|
|
|
1074 /* Merge the list we've accumulated of globals from the current input source
|
|
|
1075 into the load_history variable. The details depend on whether
|
|
|
1076 the source has an associated file name or not. */
|
|
|
1077
|
|
|
1078 static void
|
|
|
1079 build_load_history (int loading, Lisp_Object source)
|
|
|
1080 {
|
|
|
1081 REGISTER Lisp_Object tail, prev, newelt;
|
|
|
1082 REGISTER Lisp_Object tem, tem2;
|
|
|
1083 int foundit;
|
|
|
1084
|
|
|
1085 /* Don't bother recording anything for preloaded files. */
|
|
|
1086 if (purify_flag)
|
|
|
1087 return;
|
|
|
1088
|
|
|
1089 tail = Vload_history;
|
|
|
1090 prev = Qnil;
|
|
|
1091 foundit = 0;
|
|
|
1092 while (!NILP (tail))
|
|
|
1093 {
|
|
|
1094 tem = Fcar (tail);
|
|
|
1095
|
|
|
1096 /* Find the feature's previous assoc list... */
|
|
|
1097 if (!NILP (Fequal (source, Fcar (tem))))
|
|
|
1098 {
|
|
|
1099 foundit = 1;
|
|
|
1100
|
|
|
1101 /* If we're loading, remove it. */
|
|
|
1102 if (loading)
|
|
|
1103 {
|
|
|
1104 if (NILP (prev))
|
|
|
1105 Vload_history = Fcdr (tail);
|
|
|
1106 else
|
|
|
1107 Fsetcdr (prev, Fcdr (tail));
|
|
|
1108 }
|
|
|
1109
|
|
|
1110 /* Otherwise, cons on new symbols that are not already members. */
|
|
|
1111 else
|
|
|
1112 {
|
|
|
1113 tem2 = Vcurrent_load_list;
|
|
|
1114
|
|
|
1115 while (CONSP (tem2))
|
|
|
1116 {
|
|
|
1117 newelt = Fcar (tem2);
|
|
|
1118
|
|
|
1119 if (NILP (Fmemq (newelt, tem)))
|
|
|
1120 Fsetcar (tail, Fcons (Fcar (tem),
|
|
|
1121 Fcons (newelt, Fcdr (tem))));
|
|
|
1122
|
|
|
1123 tem2 = Fcdr (tem2);
|
|
|
1124 QUIT;
|
|
|
1125 }
|
|
|
1126 }
|
|
|
1127 }
|
|
|
1128 else
|
|
|
1129 prev = tail;
|
|
|
1130 tail = Fcdr (tail);
|
|
|
1131 QUIT;
|
|
|
1132 }
|
|
|
1133
|
|
|
1134 /* If we're loading, cons the new assoc onto the front of load-history,
|
|
|
1135 the most-recently-loaded position. Also do this if we didn't find
|
|
|
1136 an existing member for the current source. */
|
|
|
1137 if (loading || !foundit)
|
|
|
1138 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
|
|
|
1139 Vload_history);
|
|
|
1140 }
|
|
|
1141
|
|
|
1142 #else /* !LOADHIST */
|
|
|
1143 #define build_load_history(x,y)
|
|
|
1144 #endif /* !LOADHIST */
|
|
|
1145
|
|
|
1146
|
|
|
1147 #if 0 /* FSFmacs defun hack */
|
|
|
1148 Lisp_Object
|
|
|
1149 unreadpure (void) /* Used as unwind-protect function in readevalloop */
|
|
|
1150 {
|
|
|
1151 read_pure = 0;
|
|
|
1152 return Qnil;
|
|
|
1153 }
|
|
|
1154 #endif /* 0 */
|
|
|
1155
|
|
|
1156 static void
|
|
|
1157 readevalloop (Lisp_Object readcharfun,
|
|
|
1158 Lisp_Object sourcename,
|
|
|
1159 Lisp_Object (*evalfun) (Lisp_Object),
|
|
|
1160 int printflag)
|
|
|
1161 {
|
|
|
1162 /* This function can GC */
|
|
|
1163 REGISTER Emchar c;
|
|
|
1164 REGISTER Lisp_Object val;
|
|
|
1165 int speccount = specpdl_depth ();
|
|
|
1166 struct gcpro gcpro1;
|
|
|
1167 struct buffer *b = 0;
|
|
|
1168
|
|
|
1169 if (BUFFERP (readcharfun))
|
|
|
1170 b = XBUFFER (readcharfun);
|
|
|
1171 else if (MARKERP (readcharfun))
|
|
|
1172 b = XMARKER (readcharfun)->buffer;
|
|
|
1173
|
|
|
1174 specbind (Qstandard_input, readcharfun);
|
|
|
1175 specbind (Qcurrent_load_list, Qnil);
|
|
|
1176
|
|
|
1177 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
1178 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
1179 #endif
|
|
|
1180 GCPRO1 (sourcename);
|
|
|
1181
|
|
|
1182 LOADHIST_ATTACH (sourcename);
|
|
|
1183
|
|
|
1184 while (1)
|
|
|
1185 {
|
|
|
1186 QUIT;
|
|
|
1187
|
|
|
1188 if (b != 0 && !BUFFER_LIVE_P (b))
|
|
|
1189 error ("Reading from killed buffer");
|
|
|
1190
|
|
|
1191 c = readchar (readcharfun);
|
|
|
1192 if (c == ';')
|
|
|
1193 {
|
|
|
1194 /* Skip comment */
|
|
|
1195 while ((c = readchar (readcharfun)) != '\n' && c != -1)
|
|
|
1196 QUIT;
|
|
|
1197 continue;
|
|
|
1198 }
|
|
|
1199 if (c < 0)
|
|
|
1200 break;
|
|
|
1201
|
|
|
1202 /* Ignore whitespace here, so we can detect eof. */
|
|
|
1203 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
|
|
|
1204 continue;
|
|
|
1205
|
|
|
1206 #if 0 /* FSFmacs defun hack */
|
|
|
1207 if (purify_flag && c == '(')
|
|
|
1208 {
|
|
|
1209 int count1 = specpdl_depth ();
|
|
|
1210 record_unwind_protect (unreadpure, Qnil);
|
|
|
1211 val = read_list (readcharfun, ')', -1, 1);
|
|
|
1212 unbind_to (count1, Qnil);
|
|
|
1213 }
|
|
|
1214 else
|
|
|
1215 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
|
|
|
1216 {
|
|
|
1217 unreadchar (readcharfun, c);
|
|
|
1218 if (NILP (Vload_read_function))
|
|
|
1219 val = read0 (readcharfun);
|
|
|
1220 else
|
|
|
1221 val = call1 (Vload_read_function, readcharfun);
|
|
|
1222 }
|
|
|
1223 #endif
|
|
|
1224 val = (*evalfun) (val);
|
|
|
1225 if (printflag)
|
|
|
1226 {
|
|
|
1227 Vvalues = Fcons (val, Vvalues);
|
|
|
1228 if (EQ (Vstandard_output, Qt))
|
|
|
1229 Fprin1 (val, Qnil);
|
|
|
1230 else
|
|
|
1231 Fprint (val, Qnil);
|
|
|
1232 }
|
|
|
1233 }
|
|
|
1234
|
|
|
1235 build_load_history (LSTREAMP (readcharfun) ||
|
|
|
1236 /* This looks weird, but it's what's in FSFmacs */
|
|
|
1237 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
|
|
|
1238 sourcename);
|
|
|
1239 UNGCPRO;
|
|
|
1240
|
|
|
1241 unbind_to (speccount, Qnil);
|
|
|
1242 }
|
|
|
1243
|
|
|
1244 #ifndef standalone
|
|
|
1245
|
|
|
1246 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 2, "bBuffer: " /*
|
|
|
1247 Execute BUFFER as Lisp code.
|
|
|
1248 Programs can pass two arguments, BUFFER and PRINTFLAG.
|
|
|
1249 BUFFER is the buffer to evaluate (nil means use current buffer).
|
|
|
1250 PRINTFLAG controls printing of output:
|
|
|
1251 nil means discard it; anything else is stream for print.
|
|
|
1252
|
|
|
1253 If there is no error, point does not move. If there is an error,
|
|
|
1254 point remains at the end of the last character read from the buffer.
|
|
|
1255 Execute BUFFER as Lisp code.
|
|
|
1256 */ )
|
|
|
1257 (bufname, printflag)
|
|
|
1258 Lisp_Object bufname, printflag;
|
|
|
1259 {
|
|
|
1260 /* This function can GC */
|
|
|
1261 int speccount = specpdl_depth ();
|
|
|
1262 Lisp_Object tem, buf;
|
|
|
1263
|
|
|
1264 if (NILP (bufname))
|
|
|
1265 buf = Fcurrent_buffer ();
|
|
|
1266 else
|
|
|
1267 buf = Fget_buffer (bufname);
|
|
|
1268 if (NILP (buf))
|
|
|
1269 error ("No such buffer.");
|
|
|
1270
|
|
|
1271 if (NILP (printflag))
|
|
|
1272 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
|
|
|
1273 else
|
|
|
1274 tem = printflag;
|
|
|
1275 specbind (Qstandard_output, tem);
|
|
|
1276 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
|
|
1277 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
|
|
|
1278 readevalloop (buf, XBUFFER (buf)->filename, Feval,
|
|
|
1279 !NILP (printflag));
|
|
|
1280
|
|
|
1281 return unbind_to (speccount, Qnil);
|
|
|
1282 }
|
|
|
1283
|
|
|
1284 #if 0
|
|
|
1285 xxDEFUN ("eval-current-buffer", Feval_current_buffer, Seval_current_buffer, 0, 1, "" /*
|
|
|
1286 Execute the current buffer as Lisp code.
|
|
|
1287 Programs can pass argument PRINTFLAG which controls printing of output:
|
|
|
1288 nil means discard it; anything else is stream for print.
|
|
|
1289
|
|
|
1290 If there is no error, point does not move. If there is an error,
|
|
|
1291 point remains at the end of the last character read from the buffer.
|
|
|
1292 */ )
|
|
|
1293 (printflag)
|
|
|
1294 Lisp_Object printflag;
|
|
|
1295 {
|
|
|
1296 code omitted;
|
|
|
1297 }
|
|
|
1298 #endif
|
|
|
1299
|
|
|
1300 DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r" /*
|
|
|
1301 Execute the region as Lisp code.
|
|
|
1302 When called from programs, expects two arguments,
|
|
|
1303 giving starting and ending indices in the current buffer
|
|
|
1304 of the text to be executed.
|
|
|
1305 Programs can pass third argument PRINTFLAG which controls output:
|
|
|
1306 nil means discard it; anything else is stream for printing it.
|
|
|
1307
|
|
|
1308 If there is no error, point does not move. If there is an error,
|
|
|
1309 point remains at the end of the last character read from the buffer.
|
|
|
1310
|
|
|
1311 Note: Before evaling the region, this function narrows the buffer to it.
|
|
|
1312 If the code being eval'd should happen to trigger a redisplay you may
|
|
|
1313 see some text temporarily disappear because of this.
|
|
|
1314 */ )
|
|
|
1315 (b, e, printflag)
|
|
|
1316 Lisp_Object b, e, printflag;
|
|
|
1317 {
|
|
|
1318 /* This function can GC */
|
|
|
1319 int speccount = specpdl_depth ();
|
|
|
1320 Lisp_Object tem;
|
|
|
1321 Lisp_Object cbuf = Fcurrent_buffer ();
|
|
|
1322
|
|
|
1323 if (NILP (printflag))
|
|
|
1324 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
|
|
|
1325 else
|
|
|
1326 tem = printflag;
|
|
|
1327 specbind (Qstandard_output, tem);
|
|
|
1328
|
|
|
1329 if (NILP (printflag))
|
|
|
1330 record_unwind_protect (save_excursion_restore, save_excursion_save ());
|
|
|
1331 record_unwind_protect (save_restriction_restore, save_restriction_save ());
|
|
|
1332
|
|
|
1333 /* This both uses b and checks its type. */
|
|
|
1334 Fgoto_char (b, cbuf);
|
|
|
1335 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
|
|
|
1336 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
|
|
|
1337 !NILP (printflag));
|
|
|
1338
|
|
|
1339 return unbind_to (speccount, Qnil);
|
|
|
1340 }
|
|
|
1341
|
|
|
1342 #endif /* standalone */
|
|
|
1343
|
|
|
1344 DEFUN ("read", Fread, Sread, 0, 1, 0 /*
|
|
|
1345 Read one Lisp expression as text from STREAM, return as Lisp object.
|
|
|
1346 If STREAM is nil, use the value of `standard-input' (which see).
|
|
|
1347 STREAM or the value of `standard-input' may be:
|
|
|
1348 a buffer (read from point and advance it)
|
|
|
1349 a marker (read from where it points and advance it)
|
|
|
1350 a function (call it with no arguments for each character,
|
|
|
1351 call it with a char as argument to push a char back)
|
|
|
1352 a string (takes text from string, starting at the beginning)
|
|
|
1353 t (read text line using minibuffer and use it).
|
|
|
1354 */ )
|
|
|
1355 (stream)
|
|
|
1356 Lisp_Object stream;
|
|
|
1357 {
|
|
|
1358 if (NILP (stream))
|
|
|
1359 stream = Vstandard_input;
|
|
|
1360 if (EQ (stream, Qt))
|
|
|
1361 stream = Qread_char;
|
|
|
1362
|
|
|
1363 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
1364 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
1365 #endif
|
|
|
1366 #ifndef standalone
|
|
|
1367 if (EQ (stream, Qread_char))
|
|
|
1368 {
|
|
|
1369 Lisp_Object val = call1 (Qread_from_minibuffer,
|
|
|
1370 build_translated_string ("Lisp expression: "));
|
|
|
1371 return (Fcar (Fread_from_string (val, Qnil, Qnil)));
|
|
|
1372 }
|
|
|
1373 #endif
|
|
|
1374
|
|
|
1375 if (STRINGP (stream))
|
|
|
1376 return Fcar (Fread_from_string (stream, Qnil, Qnil));
|
|
|
1377
|
|
|
1378 return read0 (stream);
|
|
|
1379 }
|
|
|
1380
|
|
|
1381 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0 /*
|
|
|
1382 Read one Lisp expression which is represented as text by STRING.
|
|
|
1383 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
|
|
|
1384 START and END optionally delimit a substring of STRING from which to read;
|
|
|
1385 they default to 0 and (length STRING) respectively.
|
|
|
1386 */ )
|
|
|
1387 (string, start, end)
|
|
|
1388 Lisp_Object string, start, end;
|
|
|
1389 {
|
|
|
1390 Bytecount startval, endval;
|
|
|
1391 Lisp_Object tem;
|
|
|
1392 Lisp_Object lispstream = Qnil;
|
|
|
1393 struct gcpro gcpro1;
|
|
|
1394
|
|
|
1395 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
1396 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
1397 #endif
|
|
|
1398 GCPRO1 (lispstream);
|
|
|
1399 CHECK_STRING (string);
|
|
|
1400 get_string_range_byte (string, start, end, &startval, &endval,
|
|
|
1401 GB_HISTORICAL_STRING_BEHAVIOR);
|
|
|
1402 lispstream = make_lisp_string_input_stream (string, startval,
|
|
|
1403 endval - startval);
|
|
|
1404
|
|
|
1405 tem = read0 (lispstream);
|
|
|
1406 /* Yeah, it's ugly. Gonna make something of it?
|
|
|
1407 At least our reader is reentrant ... */
|
|
|
1408 tem =
|
|
|
1409 (Fcons (tem, make_int
|
|
|
1410 (bytecount_to_charcount
|
|
|
1411 (string_data (XSTRING (string)),
|
|
|
1412 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
|
|
|
1413 Lstream_delete (XLSTREAM (lispstream));
|
|
|
1414 UNGCPRO;
|
|
|
1415 return tem;
|
|
|
1416 }
|
|
|
1417
|
|
|
1418
|
|
|
1419 #ifdef LISP_BACKQUOTES
|
|
|
1420
|
|
|
1421 static Lisp_Object
|
|
|
1422 backquote_unwind (Lisp_Object ptr)
|
|
|
1423 { /* used as unwind-protect function in read0() */
|
|
|
1424 int *counter = (int *) get_opaque_ptr (ptr);
|
|
|
1425 if (--*counter < 0)
|
|
|
1426 *counter = 0;
|
|
|
1427 free_opaque_ptr (ptr);
|
|
|
1428 return Qnil;
|
|
|
1429 }
|
|
|
1430
|
|
|
1431 #endif
|
|
|
1432
|
|
|
1433 /* Use this for recursive reads, in contexts where internal tokens
|
|
|
1434 are not allowed. See also read1(). */
|
|
|
1435 static Lisp_Object
|
|
|
1436 read0 (Lisp_Object readcharfun)
|
|
|
1437 {
|
|
|
1438 Lisp_Object val;
|
|
|
1439
|
|
|
1440 val = read1 (readcharfun);
|
|
|
1441 if (CONSP (val) && UNBOUNDP (XCAR (val)))
|
|
|
1442 {
|
|
|
1443 Emchar c = XCHAR (XCDR (val));
|
|
|
1444 free_cons (XCONS (val));
|
|
|
1445 return Fsignal (Qinvalid_read_syntax,
|
|
|
1446 list1 (Fchar_to_string (make_char (c))));
|
|
|
1447 }
|
|
|
1448
|
|
|
1449 return val;
|
|
|
1450 }
|
|
|
1451
|
|
|
1452 static Emchar
|
|
|
1453 read_escape (Lisp_Object readcharfun)
|
|
|
1454 {
|
|
|
1455 /* This function can GC */
|
|
|
1456 Emchar c = readchar (readcharfun);
|
|
|
1457 switch (c)
|
|
|
1458 {
|
|
|
1459 case 'a': return '\007';
|
|
|
1460 case 'b': return '\b';
|
|
|
1461 case 'd': return 0177;
|
|
|
1462 case 'e': return 033;
|
|
|
1463 case 'f': return '\f';
|
|
|
1464 case 'n': return '\n';
|
|
|
1465 case 'r': return '\r';
|
|
|
1466 case 't': return '\t';
|
|
|
1467 case 'v': return '\v';
|
|
|
1468 case '\n': return -1;
|
|
|
1469
|
|
|
1470 case 'M':
|
|
|
1471 c = readchar (readcharfun);
|
|
|
1472 if (c != '-')
|
|
|
1473 error ("Invalid escape character syntax");
|
|
|
1474 c = readchar (readcharfun);
|
|
|
1475 if (c == '\\')
|
|
|
1476 c = read_escape (readcharfun);
|
|
|
1477 return c | 0200;
|
|
|
1478
|
|
|
1479 #define FSF_KEYS
|
|
|
1480 #ifdef FSF_KEYS
|
|
|
1481
|
|
|
1482 #define alt_modifier (0x040000)
|
|
|
1483 #define super_modifier (0x080000)
|
|
|
1484 #define hyper_modifier (0x100000)
|
|
|
1485 #define shift_modifier (0x200000)
|
|
|
1486 /* fsf uses a different modifiers for meta and control. Possibly
|
|
|
1487 byte_compiled code will still work fsfmacs, though... --Stig
|
|
|
1488
|
|
|
1489 #define ctl_modifier (0x400000)
|
|
|
1490 #define meta_modifier (0x800000)
|
|
|
1491 */
|
|
|
1492 #define FSF_LOSSAGE(mask) \
|
|
|
1493 if (puke_on_fsf_keys || ((c = readchar (readcharfun)) != '-')) \
|
|
|
1494 error ("Invalid escape character syntax"); \
|
|
|
1495 if ((c = readchar (readcharfun)) == '\\') \
|
|
|
1496 c = read_escape (readcharfun); \
|
|
|
1497 return c | mask
|
|
|
1498
|
|
|
1499 case 'S': FSF_LOSSAGE (shift_modifier);
|
|
|
1500 case 'H': FSF_LOSSAGE (hyper_modifier);
|
|
|
1501 case 'A': FSF_LOSSAGE (alt_modifier);
|
|
|
1502 case 's': FSF_LOSSAGE (super_modifier);
|
|
|
1503 #undef alt_modifier
|
|
|
1504 #undef super_modifier
|
|
|
1505 #undef hyper_modifier
|
|
|
1506 #undef shift_modifier
|
|
|
1507 #undef FSF_LOSSAGE
|
|
|
1508
|
|
|
1509 #endif /* FSF_KEYS */
|
|
|
1510
|
|
|
1511 case 'C':
|
|
|
1512 c = readchar (readcharfun);
|
|
|
1513 if (c != '-')
|
|
|
1514 error ("Invalid escape character syntax");
|
|
|
1515 case '^':
|
|
|
1516 c = readchar (readcharfun);
|
|
|
1517 if (c == '\\')
|
|
|
1518 c = read_escape (readcharfun);
|
|
|
1519 /* FSFmacs junk for non-ASCII controls.
|
|
|
1520 Not used here. */
|
|
|
1521 if (c == '?')
|
|
|
1522 return 0177;
|
|
|
1523 else
|
|
|
1524 return (c & (0200 | 037));
|
|
|
1525
|
|
|
1526 case '0':
|
|
|
1527 case '1':
|
|
|
1528 case '2':
|
|
|
1529 case '3':
|
|
|
1530 case '4':
|
|
|
1531 case '5':
|
|
|
1532 case '6':
|
|
|
1533 case '7':
|
|
|
1534 /* An octal escape, as in ANSI C. */
|
|
|
1535 {
|
|
|
1536 REGISTER Emchar i = c - '0';
|
|
|
1537 REGISTER int count = 0;
|
|
|
1538 while (++count < 3)
|
|
|
1539 {
|
|
|
1540 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
|
|
|
1541 i = (i << 3) + (c - '0');
|
|
|
1542 else
|
|
|
1543 {
|
|
|
1544 unreadchar (readcharfun, c);
|
|
|
1545 break;
|
|
|
1546 }
|
|
|
1547 }
|
|
|
1548 return i;
|
|
|
1549 }
|
|
|
1550
|
|
|
1551 case 'x':
|
|
|
1552 /* A hex escape, as in ANSI C. */
|
|
|
1553 {
|
|
|
1554 REGISTER Emchar i = 0;
|
|
|
1555 while (1)
|
|
|
1556 {
|
|
|
1557 c = readchar (readcharfun);
|
|
|
1558 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
|
|
|
1559 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
|
|
|
1560 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
|
|
|
1561 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
|
|
|
1562 else
|
|
|
1563 {
|
|
|
1564 unreadchar (readcharfun, c);
|
|
|
1565 break;
|
|
|
1566 }
|
|
|
1567 }
|
|
|
1568 return i;
|
|
|
1569 }
|
|
|
1570
|
|
|
1571 default:
|
|
|
1572 return c;
|
|
|
1573 }
|
|
|
1574 }
|
|
|
1575
|
|
|
1576
|
|
|
1577
|
|
|
1578 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
|
|
|
1579 static Bytecount
|
|
|
1580 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
|
|
|
1581 {
|
|
|
1582 /* This function can GC */
|
|
|
1583 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
|
|
|
1584 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
|
|
|
1585
|
|
|
1586 *saw_a_backslash = 0;
|
|
|
1587
|
|
|
1588 while (c > 040 /* #### - comma should be here as should backquote */
|
|
|
1589 && !(c == '\"' || c == '\'' || c == ';'
|
|
|
1590 || c == '(' || c == ')'
|
|
|
1591 #ifndef LISP_FLOAT_TYPE
|
|
|
1592 /* If we have floating-point support, then we need
|
|
|
1593 to allow <digits><dot><digits>. */
|
|
|
1594 || c =='.'
|
|
|
1595 #endif /* not LISP_FLOAT_TYPE */
|
|
|
1596 || c == '[' || c == ']' || c == '#'
|
|
|
1597 ))
|
|
|
1598 {
|
|
|
1599 if (c == '\\')
|
|
|
1600 {
|
|
|
1601 c = readchar (readcharfun);
|
|
|
1602 *saw_a_backslash = 1;
|
|
|
1603 }
|
|
|
1604 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
|
|
|
1605 QUIT;
|
|
|
1606 c = readchar (readcharfun);
|
|
|
1607 }
|
|
|
1608
|
|
|
1609 if (c >= 0)
|
|
|
1610 unreadchar (readcharfun, c);
|
|
|
1611 /* blasted terminating 0 */
|
|
|
1612 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
|
|
|
1613 Lstream_flush (XLSTREAM (Vread_buffer_stream));
|
|
|
1614
|
|
|
1615 return (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1);
|
|
|
1616 }
|
|
|
1617
|
|
|
1618 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
|
|
|
1619
|
|
|
1620 static Lisp_Object
|
|
|
1621 read_atom (Lisp_Object readcharfun,
|
|
|
1622 Emchar firstchar,
|
|
|
1623 int uninterned_symbol)
|
|
|
1624 {
|
|
|
1625 /* This function can GC */
|
|
|
1626 int saw_a_backslash;
|
|
|
1627 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
|
|
|
1628 char *read_ptr = (char *)
|
|
|
1629 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
|
|
|
1630
|
|
|
1631 /* Is it an integer? */
|
|
|
1632 if (! (saw_a_backslash || uninterned_symbol))
|
|
|
1633 {
|
|
|
1634 /* If a token had any backslashes in it, it is disqualified from
|
|
|
1635 being an integer or a float. This means that 123\456 is a
|
|
|
1636 symbol, as is \123 (which is the way (intern "123") prints).
|
|
|
1637 Also, if token was preceeded by #:, it's always a symbol.
|
|
|
1638 */
|
|
|
1639 char *p = read_ptr + len;
|
|
|
1640 char *p1 = read_ptr;
|
|
|
1641
|
|
|
1642 if (*p1 == '+' || *p1 == '-') p1++;
|
|
|
1643 if (p1 != p)
|
|
|
1644 {
|
|
|
1645 int c;
|
|
|
1646
|
|
|
1647 while (p1 != p && (c = *p1) >= '0' && c <= '9')
|
|
|
1648 p1++;
|
|
|
1649 #ifdef LISP_FLOAT_TYPE
|
|
|
1650 /* Integers can have trailing decimal points. */
|
|
|
1651 if (p1 > read_ptr && p1 < p && *p1 == '.')
|
|
|
1652 p1++;
|
|
|
1653 #endif
|
|
|
1654 if (p1 == p)
|
|
|
1655 {
|
|
|
1656 /* It is an integer. */
|
|
|
1657 #ifdef LISP_FLOAT_TYPE
|
|
|
1658 if (p1[-1] == '.')
|
|
|
1659 p1[-1] = '\0';
|
|
|
1660 #endif
|
|
|
1661 #if 0
|
|
|
1662 {
|
|
|
1663 int number = 0;
|
|
|
1664 if (sizeof (int) == sizeof (EMACS_INT))
|
|
|
1665 number = atoi (read_buffer);
|
|
|
1666 else if (sizeof (long) == sizeof (EMACS_INT))
|
|
|
1667 number = atol (read_buffer);
|
|
|
1668 else
|
|
|
1669 abort ();
|
|
|
1670 return (make_int (number));
|
|
|
1671 }
|
|
|
1672 #else
|
|
|
1673 return (parse_integer ((Bufbyte *) read_ptr, len, 10));
|
|
|
1674 #endif
|
|
|
1675 }
|
|
|
1676 }
|
|
|
1677 #ifdef LISP_FLOAT_TYPE
|
|
|
1678 if (isfloat_string (read_ptr))
|
|
|
1679 return make_float (atof (read_ptr));
|
|
|
1680 #endif
|
|
|
1681 }
|
|
|
1682
|
|
|
1683 {
|
|
|
1684 Lisp_Object sym;
|
|
|
1685 if (uninterned_symbol)
|
|
|
1686 sym = (Fmake_symbol ((purify_flag)
|
|
|
1687 ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
|
|
|
1688 : make_string ((Bufbyte *) read_ptr, len)));
|
|
|
1689 else
|
|
|
1690 {
|
|
|
1691 /* intern will purecopy pname if necessary */
|
|
|
1692 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
|
|
|
1693 sym = Fintern (name, Qnil);
|
|
|
1694 }
|
|
|
1695 if (SYMBOL_IS_KEYWORD (sym))
|
|
|
1696 {
|
|
|
1697 /* the LISP way is to put keywords in their own package, but we don't
|
|
|
1698 have packages, so we do something simpler. Someday, maybe we'll
|
|
|
1699 have packages and then this will be reworked. --Stig. */
|
|
|
1700 XSYMBOL (sym)->value = sym;
|
|
|
1701 }
|
|
|
1702 return (sym);
|
|
|
1703 }
|
|
|
1704 }
|
|
|
1705
|
|
|
1706
|
|
|
1707 static Lisp_Object
|
|
|
1708 parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
|
|
|
1709 {
|
|
|
1710 CONST Bufbyte *lim = buf + len;
|
|
|
1711 CONST Bufbyte *p = buf;
|
|
|
1712 unsigned EMACS_INT num = 0;
|
|
|
1713 int negativland = 0;
|
|
|
1714
|
|
|
1715 if (*p == '-')
|
|
|
1716 {
|
|
|
1717 negativland = 1;
|
|
|
1718 p++;
|
|
|
1719 }
|
|
|
1720 else if (*p == '+')
|
|
|
1721 {
|
|
|
1722 p++;
|
|
|
1723 }
|
|
|
1724
|
|
|
1725 if (p == lim)
|
|
|
1726 goto loser;
|
|
|
1727
|
|
|
1728 for (; p < lim; p++)
|
|
|
1729 {
|
|
|
1730 int c = *p;
|
|
|
1731 unsigned EMACS_INT onum;
|
|
|
1732
|
|
|
1733 if (isdigit (c))
|
|
|
1734 c = c - '0';
|
|
|
1735 else if (isupper (c))
|
|
|
1736 c = c - 'A' + 10;
|
|
|
1737 else if (islower (c))
|
|
|
1738 c = c - 'a' + 10;
|
|
|
1739 else
|
|
|
1740 goto loser;
|
|
|
1741
|
|
|
1742 if (c < 0 || c >= base)
|
|
|
1743 goto loser;
|
|
|
1744
|
|
|
1745 onum = num;
|
|
|
1746 num = num * base + c;
|
|
|
1747 if (num < onum)
|
|
|
1748 goto overflow;
|
|
|
1749 }
|
|
|
1750
|
|
|
1751 {
|
|
|
1752 Lisp_Object result = make_int ((negativland) ? -num : num);
|
|
|
1753 if (num && ((XINT (result) < 0) != negativland))
|
|
|
1754 goto overflow;
|
|
|
1755 if (XINT (result) != ((negativland) ? -num : num))
|
|
|
1756 goto overflow;
|
|
|
1757 return (result);
|
|
|
1758 }
|
|
|
1759 overflow:
|
|
|
1760 return Fsignal (Qinvalid_read_syntax,
|
|
|
1761 list3 (build_translated_string
|
|
|
1762 ("Integer constant overflow in reader"),
|
|
|
1763 make_string (buf, len),
|
|
|
1764 make_int (base)));
|
|
|
1765 loser:
|
|
|
1766 return Fsignal (Qinvalid_read_syntax,
|
|
|
1767 list3 (build_translated_string
|
|
|
1768 ("Invalid integer constant in reader"),
|
|
|
1769 make_string (buf, len),
|
|
|
1770 make_int (base)));
|
|
|
1771 }
|
|
|
1772
|
|
|
1773
|
|
|
1774 static Lisp_Object
|
|
|
1775 read_integer (Lisp_Object readcharfun, int base)
|
|
|
1776 {
|
|
|
1777 /* This function can GC */
|
|
|
1778 int saw_a_backslash;
|
|
|
1779 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
|
|
|
1780 return (parse_integer
|
|
|
1781 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
|
|
|
1782 ((saw_a_backslash)
|
|
|
1783 ? 0 /* make parse_integer signal error */
|
|
|
1784 : len),
|
|
|
1785 base));
|
|
|
1786 }
|
|
|
1787
|
|
|
1788 static Lisp_Object
|
|
|
1789 read_bit_vector (Lisp_Object readcharfun)
|
|
|
1790 {
|
|
|
1791 unsigned_char_dynarr *dyn = Dynarr_new (unsigned char);
|
|
|
1792 Emchar c;
|
|
|
1793
|
|
|
1794 while (1)
|
|
|
1795 {
|
|
|
1796 c = readchar (readcharfun);
|
|
|
1797 if (c != '0' && c != '1')
|
|
|
1798 break;
|
|
|
1799 Dynarr_add (dyn, (unsigned char) (c - '0'));
|
|
|
1800 }
|
|
|
1801
|
|
|
1802 if (c >= 0)
|
|
|
1803 unreadchar (readcharfun, c);
|
|
|
1804
|
|
|
1805 return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
|
|
|
1806 Dynarr_length (dyn));
|
|
|
1807 }
|
|
|
1808
|
|
|
1809
|
|
|
1810
|
|
|
1811 /* structures */
|
|
|
1812
|
|
|
1813 struct structure_type *
|
|
|
1814 define_structure_type (Lisp_Object type,
|
|
|
1815 int (*validate) (Lisp_Object data,
|
|
|
1816 Error_behavior errb),
|
|
|
1817 Lisp_Object (*instantiate) (Lisp_Object data))
|
|
|
1818 {
|
|
|
1819 struct structure_type st;
|
|
|
1820
|
|
|
1821 st.type = type;
|
|
|
1822 st.keywords = Dynarr_new (struct structure_keyword_entry);
|
|
|
1823 st.validate = validate;
|
|
|
1824 st.instantiate = instantiate;
|
|
|
1825 Dynarr_add (the_structure_type_dynarr, st);
|
|
|
1826
|
|
|
1827 return Dynarr_atp (the_structure_type_dynarr,
|
|
|
1828 Dynarr_length (the_structure_type_dynarr) - 1);
|
|
|
1829 }
|
|
|
1830
|
|
|
1831 void
|
|
|
1832 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
|
|
|
1833 int (*validate) (Lisp_Object keyword,
|
|
|
1834 Lisp_Object value,
|
|
|
1835 Error_behavior errb))
|
|
|
1836 {
|
|
|
1837 struct structure_keyword_entry en;
|
|
|
1838
|
|
|
1839 en.keyword = keyword;
|
|
|
1840 en.validate = validate;
|
|
|
1841 Dynarr_add (st->keywords, en);
|
|
|
1842 }
|
|
|
1843
|
|
|
1844 static struct structure_type *
|
|
|
1845 recognized_structure_type (Lisp_Object type)
|
|
|
1846 {
|
|
|
1847 int i;
|
|
|
1848
|
|
|
1849 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
|
|
|
1850 {
|
|
|
1851 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
|
|
|
1852 if (EQ (st->type, type))
|
|
|
1853 return st;
|
|
|
1854 }
|
|
|
1855
|
|
|
1856 return 0;
|
|
|
1857 }
|
|
|
1858
|
|
|
1859 static Lisp_Object
|
|
|
1860 read_structure (Lisp_Object readcharfun)
|
|
|
1861 {
|
|
|
1862 Emchar c = readchar (readcharfun);
|
|
|
1863 Lisp_Object list = Qnil;
|
|
|
1864 Lisp_Object orig_list = Qnil;
|
|
|
1865 Lisp_Object already_seen = Qnil;
|
|
|
1866 struct structure_type *st;
|
|
|
1867 struct gcpro gcpro1, gcpro2;
|
|
|
1868
|
|
|
1869 GCPRO2 (orig_list, already_seen);
|
|
|
1870 if (c != '(')
|
|
|
1871 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
|
|
|
1872 list = read_list (readcharfun, ')', 0, 0);
|
|
|
1873 orig_list = list;
|
|
|
1874 {
|
|
|
1875 int len = XINT (Flength (list));
|
|
|
1876 if (len == 0)
|
|
|
1877 RETURN_UNGCPRO (continuable_syntax_error
|
|
|
1878 ("structure type not specified"));
|
|
|
1879 if (!(len & 1))
|
|
|
1880 RETURN_UNGCPRO
|
|
|
1881 (continuable_syntax_error
|
|
|
1882 ("structures must have alternating keyword/value pairs"));
|
|
|
1883 }
|
|
|
1884
|
|
|
1885 st = recognized_structure_type (XCAR (list));
|
|
|
1886 if (!st)
|
|
|
1887 {
|
|
|
1888 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
|
1889 list2 (build_translated_string
|
|
|
1890 ("unrecognized structure type"),
|
|
|
1891 XCAR (list))));
|
|
|
1892 }
|
|
|
1893
|
|
|
1894 list = Fcdr (list);
|
|
|
1895 while (!NILP (list))
|
|
|
1896 {
|
|
|
1897 Lisp_Object keyword, value;
|
|
|
1898 int i;
|
|
|
1899 struct structure_keyword_entry *en;
|
|
|
1900
|
|
|
1901 keyword = Fcar (list);
|
|
|
1902 list = Fcdr (list);
|
|
|
1903 value = Fcar (list);
|
|
|
1904 list = Fcdr (list);
|
|
|
1905
|
|
|
1906 if (!NILP (memq_no_quit (keyword, already_seen)))
|
|
|
1907 {
|
|
|
1908 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
|
1909 list2 (build_translated_string
|
|
|
1910 ("structure keyword already seen"),
|
|
|
1911 keyword)));
|
|
|
1912 }
|
|
|
1913
|
|
|
1914 for (i = 0; i < Dynarr_length (st->keywords); i++)
|
|
|
1915 {
|
|
|
1916 en = Dynarr_atp (st->keywords, i);
|
|
|
1917 if (EQ (keyword, en->keyword))
|
|
|
1918 break;
|
|
|
1919 }
|
|
|
1920
|
|
|
1921 if (i == Dynarr_length (st->keywords))
|
|
|
1922 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
|
|
|
1923 list2 (build_translated_string
|
|
|
1924 ("unrecognized structure keyword"),
|
|
|
1925 keyword)));
|
|
|
1926
|
|
|
1927 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
|
|
|
1928 RETURN_UNGCPRO
|
|
|
1929 (Fsignal (Qinvalid_read_syntax,
|
|
|
1930 list3 (build_translated_string
|
|
|
1931 ("invalid value for structure keyword"),
|
|
|
1932 keyword, value)));
|
|
|
1933
|
|
|
1934 already_seen = Fcons (keyword, already_seen);
|
|
|
1935 }
|
|
|
1936
|
|
|
1937 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
|
|
|
1938 RETURN_UNGCPRO
|
|
|
1939 (Fsignal (Qinvalid_read_syntax,
|
|
|
1940 list2 (build_translated_string
|
|
|
1941 ("invalid structure initializer"),
|
|
|
1942 orig_list)));
|
|
|
1943
|
|
|
1944 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
|
|
|
1945 }
|
|
|
1946
|
|
|
1947
|
|
|
1948 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
|
|
|
1949 int terminator);
|
|
|
1950 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
|
|
|
1951
|
|
|
1952 /* Get the next character; filter out whitespace and comments */
|
|
|
1953
|
|
|
1954 static Emchar
|
|
|
1955 reader_nextchar (Lisp_Object readcharfun)
|
|
|
1956 {
|
|
|
1957 /* This function can GC */
|
|
|
1958 Emchar c;
|
|
|
1959
|
|
|
1960 retry:
|
|
|
1961 QUIT;
|
|
|
1962 c = readchar (readcharfun);
|
|
|
1963 if (c < 0)
|
|
|
1964 {
|
|
|
1965 if (LSTREAMP (readcharfun))
|
|
|
1966 signal_error (Qend_of_file,
|
|
|
1967 list1 (build_string ("internal input stream")));
|
|
|
1968 else
|
|
|
1969 signal_error (Qend_of_file, list1 (readcharfun));
|
|
|
1970 }
|
|
|
1971
|
|
|
1972 switch (c)
|
|
|
1973 {
|
|
|
1974 default:
|
|
|
1975 {
|
|
|
1976 /* Ignore whitespace and control characters */
|
|
|
1977 if (c <= 040)
|
|
|
1978 goto retry;
|
|
|
1979 return (c);
|
|
|
1980 }
|
|
|
1981
|
|
|
1982 case ';':
|
|
|
1983 {
|
|
|
1984 /* Comment */
|
|
|
1985 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
|
|
|
1986 QUIT;
|
|
|
1987 goto retry;
|
|
|
1988 }
|
|
|
1989 }
|
|
|
1990 }
|
|
|
1991
|
|
|
1992 #if 0
|
|
|
1993 static Lisp_Object
|
|
|
1994 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
|
|
|
1995 {
|
|
|
1996 if (pure)
|
|
|
1997 return (pure_cons (a, pure_cons (b, Qnil)));
|
|
|
1998 else
|
|
|
1999 return (list2 (a, b));
|
|
|
2000 }
|
|
|
2001 #endif
|
|
|
2002
|
|
|
2003 /* Read the next Lisp object from the stream READCHARFUN and return it.
|
|
|
2004 If the return value is a cons whose car is Qunbound, then read1()
|
|
|
2005 encountered a misplaced token (e.g. a right bracket, right paren,
|
|
|
2006 or dot followed by a non-number). To filter this stuff out,
|
|
|
2007 use read0(). */
|
|
|
2008
|
|
|
2009 static Lisp_Object
|
|
|
2010 read1 (Lisp_Object readcharfun)
|
|
|
2011 {
|
|
|
2012 Emchar c;
|
|
|
2013
|
|
|
2014 retry:
|
|
|
2015 c = reader_nextchar (readcharfun);
|
|
|
2016
|
|
|
2017 switch (c)
|
|
|
2018 {
|
|
|
2019 case '(':
|
|
|
2020 {
|
|
|
2021 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
|
|
|
2022 /* if this is disabled, then other code in eval.c must be enabled */
|
|
|
2023 Emchar ch = reader_nextchar (readcharfun);
|
|
|
2024 switch (ch)
|
|
|
2025 {
|
|
|
2026 case '`':
|
|
|
2027 {
|
|
|
2028 Lisp_Object tem;
|
|
|
2029 int speccount = specpdl_depth ();
|
|
|
2030 ++old_backquote_flag;
|
|
|
2031 record_unwind_protect (backquote_unwind,
|
|
|
2032 make_opaque_ptr (&old_backquote_flag));
|
|
|
2033 tem = read0 (readcharfun);
|
|
|
2034 unbind_to (speccount, Qnil);
|
|
|
2035 ch = reader_nextchar (readcharfun);
|
|
|
2036 if (ch != ')')
|
|
|
2037 {
|
|
|
2038 unreadchar (readcharfun, ch);
|
|
|
2039 return Fsignal (Qinvalid_read_syntax,
|
|
|
2040 list1 (build_string
|
|
|
2041 ("Weird old-backquote syntax")));
|
|
|
2042 }
|
|
|
2043 return list2 (Qbacktick, tem);
|
|
|
2044 }
|
|
|
2045 case ',':
|
|
|
2046 {
|
|
|
2047 if (old_backquote_flag)
|
|
|
2048 {
|
|
|
2049 Lisp_Object tem, comma_type;
|
|
|
2050 ch = readchar (readcharfun);
|
|
|
2051 if (ch == '@')
|
|
|
2052 comma_type = Qcomma_at;
|
|
|
2053 else
|
|
|
2054 {
|
|
|
2055 if (ch >= 0)
|
|
|
2056 unreadchar (readcharfun, ch);
|
|
|
2057 comma_type = Qcomma;
|
|
|
2058 }
|
|
|
2059 tem = read0 (readcharfun);
|
|
|
2060 ch = reader_nextchar (readcharfun);
|
|
|
2061 if (ch != ')')
|
|
|
2062 {
|
|
|
2063 unreadchar (readcharfun, ch);
|
|
|
2064 return Fsignal (Qinvalid_read_syntax,
|
|
|
2065 list1 (build_string
|
|
|
2066 ("Weird old-backquote syntax")));
|
|
|
2067 }
|
|
|
2068 return list2 (comma_type, tem);
|
|
|
2069 }
|
|
|
2070 else
|
|
|
2071 {
|
|
|
2072 unreadchar (readcharfun, ch);
|
|
|
2073 #if 0
|
|
|
2074 return Fsignal (Qinvalid_read_syntax,
|
|
|
2075 list1 (build_string ("Comma outside of backquote")));
|
|
|
2076 #else
|
|
|
2077 /* #### - yuck....but this is reverse compatible. */
|
|
|
2078 /* mostly this is required by edebug, which does it's own
|
|
|
2079 annotated reading. We need to have an annotated_read
|
|
|
2080 function that records (with markers) the buffer
|
|
|
2081 positions of the elements that make up lists, then that
|
|
|
2082 can be used in edebug and bytecomp and the check above
|
|
|
2083 can go back in. --Stig */
|
|
|
2084 break;
|
|
|
2085 #endif
|
|
|
2086 }
|
|
|
2087 }
|
|
|
2088 default:
|
|
|
2089 unreadchar (readcharfun, ch);
|
|
|
2090 } /* switch(ch) */
|
|
|
2091 #endif /* old backquote crap... */
|
|
|
2092 return read_list (readcharfun, ')', 1, 1);
|
|
|
2093 }
|
|
|
2094 case '[':
|
|
|
2095 return (read_vector (readcharfun, ']'));
|
|
|
2096
|
|
|
2097 case ')':
|
|
|
2098 case ']':
|
|
|
2099 /* #### - huh? these don't do what they seem... */
|
|
|
2100 return (noseeum_cons (Qunbound, make_char (c)));
|
|
|
2101 case '.':
|
|
|
2102 {
|
|
|
2103 #ifdef LISP_FLOAT_TYPE
|
|
|
2104 /* If a period is followed by a number, then we should read it
|
|
|
2105 as a floating point number. Otherwise, it denotes a dotted
|
|
|
2106 pair.
|
|
|
2107 */
|
|
|
2108 c = readchar (readcharfun);
|
|
|
2109 unreadchar (readcharfun, c);
|
|
|
2110
|
|
|
2111 /* Can't use isdigit on Emchars */
|
|
|
2112 if (c < '0' || c > '9')
|
|
|
2113 return (noseeum_cons (Qunbound, make_char ('.')));
|
|
|
2114
|
|
|
2115 /* Note that read_atom will loop
|
|
|
2116 at least once, assuring that we will not try to UNREAD
|
|
|
2117 two characters in a row.
|
|
|
2118 (I think this doesn't matter anymore because there should
|
|
|
2119 be no more danger in unreading multiple characters) */
|
|
|
2120 return (read_atom (readcharfun, '.', 0));
|
|
|
2121
|
|
|
2122 #else /* ! LISP_FLOAT_TYPE */
|
|
|
2123 return (noseeum_cons (Qunbound, make_char ('.')));
|
|
|
2124 #endif /* ! LISP_FLOAT_TYPE */
|
|
|
2125 }
|
|
|
2126
|
|
|
2127 case '#':
|
|
|
2128 {
|
|
|
2129 c = readchar (readcharfun);
|
|
|
2130 switch (c)
|
|
|
2131 {
|
|
|
2132 #if 0 /* FSFmacs silly char-table syntax */
|
|
|
2133 case '^':
|
|
|
2134 #endif
|
|
|
2135 #if 0 /* FSFmacs silly bool-vector syntax */
|
|
|
2136 case '&':
|
|
|
2137 #endif
|
|
|
2138 /* "#["-- byte-code constant syntax */
|
|
|
2139 /* purecons #[...] syntax */
|
|
|
2140 case '[': return (read_compiled_function (readcharfun, ']'
|
|
|
2141 /*, purify_flag */ ));
|
|
|
2142 /* "#:"-- quasi-implemented gensym syntax */
|
|
|
2143 case ':': return (read_atom (readcharfun, -1, 1));
|
|
|
2144 /* #'x => (function x) */
|
|
|
2145 case '\'': return (list2 (Qfunction, read0 (readcharfun)));
|
|
|
2146 #if 0
|
|
|
2147 /* RMS uses this syntax for fat-strings.
|
|
|
2148 If we use it for vectors, then obscure bugs happen.
|
|
|
2149 */
|
|
|
2150 /* "#(" -- Scheme/CL vector syntax */
|
|
|
2151 case '(': return (read_vector (readcharfun, ')'));
|
|
|
2152 #endif
|
|
|
2153 #if 0 /* FSFmacs */
|
|
|
2154 case '(':
|
|
|
2155 {
|
|
|
2156 Lisp_Object tmp;
|
|
|
2157 struct gcpro gcpro1;
|
|
|
2158
|
|
|
2159 /* Read the string itself. */
|
|
|
2160 tmp = read1 (readcharfun);
|
|
|
2161 if (!STRINGP (tmp))
|
|
|
2162 {
|
|
|
2163 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
|
|
|
2164 free_cons (XCONS (tmp));
|
|
|
2165 return (Fsignal (Qinvalid_read_syntax,
|
|
|
2166 list1 (build_string ("#"))));
|
|
|
2167 }
|
|
|
2168 GCPRO1 (tmp);
|
|
|
2169 /* Read the intervals and their properties. */
|
|
|
2170 while (1)
|
|
|
2171 {
|
|
|
2172 Lisp_Object beg, end, plist;
|
|
|
2173 Emchar ch;
|
|
|
2174 int invalid = 0;
|
|
|
2175
|
|
|
2176 beg = read1 (readcharfun);
|
|
|
2177 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
|
|
|
2178 {
|
|
|
2179 ch = XCHAR (XCDR (beg));
|
|
|
2180 free_cons (XCONS (beg));
|
|
|
2181 if (ch == ')')
|
|
|
2182 break;
|
|
|
2183 else
|
|
|
2184 invalid = 1;
|
|
|
2185 }
|
|
|
2186 if (!invalid)
|
|
|
2187 {
|
|
|
2188 end = read1 (readcharfun);
|
|
|
2189 if (CONSP (end) && UNBOUNDP (XCAR (end)))
|
|
|
2190 {
|
|
|
2191 free_cons (XCONS (end));
|
|
|
2192 invalid = 1;
|
|
|
2193 }
|
|
|
2194 }
|
|
|
2195 if (!invalid)
|
|
|
2196 {
|
|
|
2197 plist = read1 (readcharfun);
|
|
|
2198 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
|
|
|
2199 {
|
|
|
2200 free_cons (XCONS (plist));
|
|
|
2201 invalid = 1;
|
|
|
2202 }
|
|
|
2203 }
|
|
|
2204 if (invalid)
|
|
|
2205 RETURN_UNGCPRO
|
|
|
2206 (Fsignal (Qinvalid_read_syntax,
|
|
|
2207 list2
|
|
|
2208 (build_string ("invalid string property list"),
|
|
|
2209 XCDR (plist))));
|
|
|
2210 Fset_text_properties (beg, end, plist, tmp);
|
|
|
2211 }
|
|
|
2212 UNGCPRO;
|
|
|
2213 return tmp;
|
|
|
2214 }
|
|
|
2215 #endif /* 0 */
|
|
|
2216 case '@':
|
|
|
2217 {
|
|
|
2218 /* #@NUMBER is used to skip NUMBER following characters.
|
|
|
2219 That's used in .elc files to skip over doc strings
|
|
|
2220 and function definitions. */
|
|
|
2221 int i, nskip = 0;
|
|
|
2222
|
|
|
2223 /* Read a decimal integer. */
|
|
|
2224 while ((c = readchar (readcharfun)) >= 0
|
|
|
2225 && c >= '0' && c <= '9')
|
|
|
2226 nskip = (10 * nskip) + (c - '0');
|
|
|
2227 if (c >= 0)
|
|
|
2228 unreadchar (readcharfun, c);
|
|
|
2229
|
|
|
2230 /* FSF has code here that maybe caches the skipped
|
|
|
2231 string. See above for why this is totally
|
|
|
2232 losing. We handle this differently. */
|
|
|
2233
|
|
|
2234 /* Skip that many characters. */
|
|
|
2235 for (i = 0; i < nskip && c >= 0; i++)
|
|
|
2236 c = readchar (readcharfun);
|
|
|
2237
|
|
|
2238 goto retry;
|
|
|
2239 }
|
|
|
2240 case '$': return Vload_file_name_internal;
|
|
|
2241 /* bit vectors */
|
|
|
2242 case '*': return (read_bit_vector (readcharfun));
|
|
|
2243 /* #o10 => 8 -- octal constant syntax */
|
|
|
2244 case 'o': return (read_integer (readcharfun, 8));
|
|
|
2245 /* #xdead => 57005 -- hex constant syntax */
|
|
|
2246 case 'x': return (read_integer (readcharfun, 16));
|
|
|
2247 /* #b010 => 2 -- binary constant syntax */
|
|
|
2248 case 'b': return (read_integer (readcharfun, 2));
|
|
|
2249 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
|
|
|
2250 case 's': return (read_structure (readcharfun));
|
|
|
2251 case '<':
|
|
|
2252 {
|
|
|
2253 unreadchar (readcharfun, c);
|
|
|
2254 return Fsignal (Qinvalid_read_syntax,
|
|
|
2255 list1 (build_string ("Cannot read unreadable object")));
|
|
|
2256 }
|
|
|
2257
|
|
|
2258 default:
|
|
|
2259 {
|
|
|
2260 unreadchar (readcharfun, c);
|
|
|
2261 return Fsignal (Qinvalid_read_syntax,
|
|
|
2262 list1 (build_string ("#")));
|
|
|
2263 }
|
|
|
2264 }
|
|
|
2265 }
|
|
|
2266
|
|
|
2267 /* Quote */
|
|
|
2268 case '\'': return list2 (Qquote, read0 (readcharfun));
|
|
|
2269
|
|
|
2270 #ifdef LISP_BACKQUOTES
|
|
|
2271 case '`':
|
|
|
2272 {
|
|
|
2273 Lisp_Object tem;
|
|
|
2274 int speccount = specpdl_depth ();
|
|
|
2275 ++new_backquote_flag;
|
|
|
2276 record_unwind_protect (backquote_unwind,
|
|
|
2277 make_opaque_ptr (&new_backquote_flag));
|
|
|
2278 tem = read0 (readcharfun);
|
|
|
2279 unbind_to (speccount, Qnil);
|
|
|
2280 return list2 (Qbackquote, tem);
|
|
|
2281 }
|
|
|
2282
|
|
|
2283 case ',':
|
|
|
2284 {
|
|
|
2285 if (new_backquote_flag)
|
|
|
2286 {
|
|
|
2287 Lisp_Object comma_type = Qnil;
|
|
|
2288 int ch = readchar (readcharfun);
|
|
|
2289
|
|
|
2290 if (ch == '@')
|
|
|
2291 comma_type = Qcomma_at;
|
|
|
2292 else if (ch == '.')
|
|
|
2293 comma_type = Qcomma_dot;
|
|
|
2294 else
|
|
|
2295 {
|
|
|
2296 if (ch >= 0)
|
|
|
2297 unreadchar (readcharfun, ch);
|
|
|
2298 comma_type = Qcomma;
|
|
|
2299 }
|
|
|
2300 return list2 (comma_type, read0 (readcharfun));
|
|
|
2301 }
|
|
|
2302 else
|
|
|
2303 {
|
|
|
2304 /* YUCK. 99.999% backwards compatibility. The Right
|
|
|
2305 Thing(tm) is to signal an error here, because it's
|
|
|
2306 really invalid read syntax. Instead, this permits
|
|
|
2307 commas to begin symbols (unless they're inside
|
|
|
2308 backquotes). If an error is signalled here in the
|
|
|
2309 future, then commas should be invalid read syntax
|
|
|
2310 outside of backquotes anywhere they're found (i.e.
|
|
|
2311 they must be quoted in symbols) -- Stig */
|
|
|
2312 return (read_atom (readcharfun, c, 0));
|
|
|
2313 }
|
|
|
2314 }
|
|
|
2315 #endif
|
|
|
2316
|
|
|
2317 case '?':
|
|
|
2318 {
|
|
|
2319 /* Evil GNU Emacs "character" (ie integer) syntax */
|
|
|
2320 c = readchar (readcharfun);
|
|
|
2321 if (c < 0)
|
|
|
2322 return Fsignal (Qend_of_file, list1 (readcharfun));
|
|
|
2323
|
|
|
2324 if (c == '\\')
|
|
|
2325 c = read_escape (readcharfun);
|
|
|
2326 return (make_char (c));
|
|
|
2327 }
|
|
|
2328
|
|
|
2329 case '\"':
|
|
|
2330 {
|
|
|
2331 /* String */
|
|
|
2332 #ifdef I18N3
|
|
|
2333 /* #### If the input stream is translating, then the string
|
|
|
2334 should be marked as translatable by setting its
|
|
|
2335 `string-translatable' property to t. .el and .elc files
|
|
|
2336 normally are translating input streams. See Fgettext()
|
|
|
2337 and print_internal(). */
|
|
|
2338 #endif
|
|
|
2339 int cancel = 0;
|
|
|
2340
|
|
|
2341 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
|
|
|
2342 while ((c = readchar (readcharfun)) >= 0
|
|
|
2343 && c != '\"')
|
|
|
2344 {
|
|
|
2345 if (c == '\\')
|
|
|
2346 c = read_escape (readcharfun);
|
|
|
2347 /* c is -1 if \ newline has just been seen */
|
|
|
2348 if (c == -1)
|
|
|
2349 {
|
|
|
2350 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
|
|
|
2351 cancel = 1;
|
|
|
2352 }
|
|
|
2353 else
|
|
|
2354 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
|
|
|
2355 QUIT;
|
|
|
2356 }
|
|
|
2357 if (c < 0)
|
|
|
2358 return Fsignal (Qend_of_file, list1 (readcharfun));
|
|
|
2359
|
|
|
2360 /* If purifying, and string starts with \ newline,
|
|
|
2361 return zero instead. This is for doc strings
|
|
|
2362 that we are really going to find in lib-src/DOC.nn.nn */
|
|
|
2363 if (purify_flag && NILP (Vdoc_file_name) && cancel)
|
|
|
2364 return (Qzero);
|
|
|
2365
|
|
|
2366 Lstream_flush (XLSTREAM (Vread_buffer_stream));
|
|
|
2367 #if 0 /* FSFmacs defun hack */
|
|
|
2368 if (read_pure)
|
|
|
2369 return
|
|
|
2370 make_pure_string
|
|
|
2371 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
|
|
|
2372 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
|
|
|
2373 else
|
|
|
2374 #endif
|
|
|
2375 return
|
|
|
2376 make_string
|
|
|
2377 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
|
|
|
2378 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
|
|
|
2379 }
|
|
|
2380
|
|
|
2381 default:
|
|
|
2382 {
|
|
|
2383 /* Ignore whitespace and control characters */
|
|
|
2384 if (c <= 040)
|
|
|
2385 goto retry;
|
|
|
2386 return (read_atom (readcharfun, c, 0));
|
|
|
2387 }
|
|
|
2388 }
|
|
|
2389 }
|
|
|
2390
|
|
|
2391
|
|
|
2392
|
|
|
2393 #ifdef LISP_FLOAT_TYPE
|
|
|
2394
|
|
|
2395 #define LEAD_INT 1
|
|
|
2396 #define DOT_CHAR 2
|
|
|
2397 #define TRAIL_INT 4
|
|
|
2398 #define E_CHAR 8
|
|
|
2399 #define EXP_INT 16
|
|
|
2400
|
|
|
2401 int
|
|
|
2402 isfloat_string (CONST char *cp)
|
|
|
2403 {
|
|
|
2404 int state = 0;
|
|
|
2405 CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
|
|
|
2406
|
|
|
2407 if (*ucp == '+' || *ucp == '-')
|
|
|
2408 ucp++;
|
|
|
2409
|
|
|
2410 if (*ucp >= '0' && *ucp <= '9')
|
|
|
2411 {
|
|
|
2412 state |= LEAD_INT;
|
|
|
2413 while (*ucp >= '0' && *ucp <= '9')
|
|
|
2414 ucp++;
|
|
|
2415 }
|
|
|
2416 if (*ucp == '.')
|
|
|
2417 {
|
|
|
2418 state |= DOT_CHAR;
|
|
|
2419 ucp++;
|
|
|
2420 }
|
|
|
2421 if (*ucp >= '0' && *ucp <= '9')
|
|
|
2422 {
|
|
|
2423 state |= TRAIL_INT;
|
|
|
2424 while (*ucp >= '0' && *ucp <= '9')
|
|
|
2425 ucp++;
|
|
|
2426 }
|
|
|
2427 if (*ucp == 'e' || *ucp == 'E')
|
|
|
2428 {
|
|
|
2429 state |= E_CHAR;
|
|
|
2430 ucp++;
|
|
|
2431 if ((*ucp == '+') || (*ucp == '-'))
|
|
|
2432 ucp++;
|
|
|
2433 }
|
|
|
2434
|
|
|
2435 if (*ucp >= '0' && *ucp <= '9')
|
|
|
2436 {
|
|
|
2437 state |= EXP_INT;
|
|
|
2438 while (*ucp >= '0' && *ucp <= '9')
|
|
|
2439 ucp++;
|
|
|
2440 }
|
|
|
2441 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
|
|
|
2442 || (*ucp == '\r') || (*ucp == '\f'))
|
|
|
2443 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
|
|
|
2444 || state == (DOT_CHAR|TRAIL_INT)
|
|
|
2445 || state == (LEAD_INT|E_CHAR|EXP_INT)
|
|
|
2446 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
|
|
|
2447 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
|
|
|
2448 }
|
|
|
2449 #endif /* LISP_FLOAT_TYPE */
|
|
|
2450
|
|
|
2451 static void *
|
|
|
2452 sequence_reader (Lisp_Object readcharfun,
|
|
|
2453 Emchar terminator,
|
|
|
2454 void *state,
|
|
|
2455 void * (*conser) (Lisp_Object readcharfun,
|
|
|
2456 void *state, Charcount len))
|
|
|
2457 {
|
|
|
2458 Charcount len;
|
|
|
2459
|
|
|
2460 for (len = 0; ; len++)
|
|
|
2461 {
|
|
|
2462 Emchar ch;
|
|
|
2463
|
|
|
2464 QUIT;
|
|
|
2465 ch = reader_nextchar (readcharfun);
|
|
|
2466
|
|
|
2467 if (ch == terminator)
|
|
|
2468 return (state);
|
|
|
2469 else
|
|
|
2470 unreadchar (readcharfun, ch);
|
|
|
2471 if (ch == ']')
|
|
|
2472 syntax_error ("\"]\" in a list");
|
|
|
2473 else if (ch == ')')
|
|
|
2474 syntax_error ("\")\" in a vector");
|
|
|
2475 state = ((conser) (readcharfun, state, len));
|
|
|
2476 }
|
|
|
2477 }
|
|
|
2478
|
|
|
2479
|
|
|
2480 struct read_list_state
|
|
|
2481 {
|
|
|
2482 Lisp_Object head;
|
|
|
2483 Lisp_Object tail;
|
|
|
2484 int length;
|
|
|
2485 int allow_dotted_lists;
|
|
|
2486 Emchar terminator;
|
|
|
2487 };
|
|
|
2488
|
|
|
2489 static void *
|
|
|
2490 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
|
|
|
2491 {
|
|
|
2492 struct read_list_state *s = state;
|
|
|
2493 Lisp_Object elt;
|
|
|
2494
|
|
|
2495 elt = read1 (readcharfun);
|
|
|
2496
|
|
|
2497 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
|
|
|
2498 {
|
|
|
2499 Lisp_Object tem = elt;
|
|
|
2500 Emchar ch;
|
|
|
2501
|
|
|
2502 elt = XCDR (elt);
|
|
|
2503 free_cons (XCONS (tem));
|
|
|
2504 tem = Qnil;
|
|
|
2505 ch = XCHAR (elt);
|
|
|
2506 if (ch != '.')
|
|
|
2507 signal_simple_error ("BUG! Internal reader error", elt);
|
|
|
2508 else if (!s->allow_dotted_lists)
|
|
|
2509 syntax_error ("\".\" in a vector");
|
|
|
2510 else
|
|
|
2511 {
|
|
|
2512 if (!NILP (s->tail))
|
|
|
2513 XCDR (s->tail) = read0 (readcharfun);
|
|
|
2514 else
|
|
|
2515 s->head = read0 (readcharfun);
|
|
|
2516 elt = read1 (readcharfun);
|
|
|
2517 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
|
|
|
2518 {
|
|
|
2519 ch = XCHAR (XCDR (elt));
|
|
|
2520 free_cons (XCONS (elt));
|
|
|
2521 if (ch == s->terminator)
|
|
|
2522 {
|
|
|
2523 unreadchar (readcharfun, s->terminator);
|
|
|
2524 goto done;
|
|
|
2525 }
|
|
|
2526 }
|
|
|
2527 syntax_error (". in wrong context");
|
|
|
2528 }
|
|
|
2529 }
|
|
|
2530
|
|
|
2531 #if 0 /* FSFmacs defun hack, or something ... */
|
|
|
2532 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
|
|
|
2533 {
|
|
|
2534 record_unwind_protect (unreadpure, Qzero);
|
|
|
2535 read_pure = 1;
|
|
|
2536 }
|
|
|
2537 #endif
|
|
|
2538
|
|
|
2539 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
2540 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
|
|
|
2541 {
|
|
|
2542 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
|
|
|
2543 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
|
|
|
2544 else
|
|
|
2545 Vcurrent_compiled_function_annotation = elt;
|
|
|
2546 }
|
|
|
2547 #endif
|
|
|
2548
|
|
|
2549 elt = Fcons (elt, Qnil);
|
|
|
2550 if (!NILP (s->tail))
|
|
|
2551 XCDR (s->tail) = elt;
|
|
|
2552 else
|
|
|
2553 s->head = elt;
|
|
|
2554 s->tail = elt;
|
|
|
2555 done:
|
|
|
2556 s->length++;
|
|
|
2557 return (s);
|
|
|
2558 }
|
|
|
2559
|
|
|
2560
|
|
|
2561 #if 0 /* FSFmacs defun hack */
|
|
|
2562 /* -1 for allow_dotted_lists means allow_dotted_lists and check
|
|
|
2563 for starting with defun and make structure pure. */
|
|
|
2564 #endif
|
|
|
2565
|
|
|
2566 static Lisp_Object
|
|
|
2567 read_list (Lisp_Object readcharfun,
|
|
|
2568 Emchar terminator,
|
|
|
2569 int allow_dotted_lists,
|
|
|
2570 int check_for_doc_references)
|
|
|
2571 {
|
|
|
2572 struct read_list_state s;
|
|
|
2573 struct gcpro gcpro1, gcpro2;
|
|
|
2574 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
2575 Lisp_Object old_compiled_function_annotation =
|
|
|
2576 Vcurrent_compiled_function_annotation;
|
|
|
2577 #endif
|
|
|
2578
|
|
|
2579 s.head = Qnil;
|
|
|
2580 s.tail = Qnil;
|
|
|
2581 s.length = 0;
|
|
|
2582 s.allow_dotted_lists = allow_dotted_lists;
|
|
|
2583 s.terminator = terminator;
|
|
|
2584 GCPRO2 (s.head, s.tail);
|
|
|
2585
|
|
|
2586 (void) sequence_reader (readcharfun,
|
|
|
2587 terminator,
|
|
|
2588 &s,
|
|
|
2589 read_list_conser);
|
|
|
2590 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
2591 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
|
|
|
2592 #endif
|
|
|
2593
|
|
|
2594 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
|
|
|
2595 {
|
|
|
2596 /* check now for any doc string references and record them
|
|
|
2597 for later. */
|
|
|
2598 Lisp_Object tail;
|
|
|
2599
|
|
|
2600 /* We might be dealing with an imperfect list so don't
|
|
|
2601 use LIST_LOOP */
|
|
|
2602 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
|
|
|
2603 {
|
|
|
2604 Lisp_Object holding_cons = Qnil;
|
|
|
2605
|
|
|
2606 {
|
|
|
2607 Lisp_Object elem = XCAR (tail);
|
|
|
2608 /* elem might be (#$ . INT) ... */
|
|
|
2609 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
|
|
|
2610 holding_cons = tail;
|
|
|
2611 /* or it might be (quote (#$ . INT)) i.e.
|
|
|
2612 (quote . ((#$ . INT) . nil)) in the case of
|
|
|
2613 `autoload' (autoload evaluates its arguments, while
|
|
|
2614 `defvar', `defun', etc. don't). */
|
|
|
2615 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
|
|
|
2616 && CONSP (XCDR (elem)))
|
|
|
2617 {
|
|
|
2618 elem = XCAR (XCDR (elem));
|
|
|
2619 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
|
|
|
2620 holding_cons = XCDR (XCAR (tail));
|
|
|
2621 }
|
|
|
2622 }
|
|
|
2623
|
|
|
2624 if (CONSP (holding_cons))
|
|
|
2625 {
|
|
|
2626 if (purify_flag)
|
|
|
2627 {
|
|
|
2628 if (NILP (Vdoc_file_name))
|
|
|
2629 /* We have not yet called Snarf-documentation, so
|
|
|
2630 assume this file is described in the DOC-MM.NN
|
|
|
2631 file and Snarf-documentation will fill in the
|
|
|
2632 right value later. For now, replace the whole
|
|
|
2633 list with 0. */
|
|
|
2634 XCAR (holding_cons) = Qzero;
|
|
|
2635 else
|
|
|
2636 /* We have already called Snarf-documentation, so
|
|
|
2637 make a relative file name for this file, so it
|
|
|
2638 can be found properly in the installed Lisp
|
|
|
2639 directory. We don't use Fexpand_file_name
|
|
|
2640 because that would make the directory absolute
|
|
|
2641 now. */
|
|
|
2642 XCAR (XCAR (holding_cons)) =
|
|
|
2643 concat2 (build_string ("../lisp/"),
|
|
|
2644 Ffile_name_nondirectory
|
|
|
2645 (Vload_file_name_internal));
|
|
|
2646 }
|
|
|
2647 else
|
|
|
2648 /* Not pure. Just add to Vload_force_doc_string_list,
|
|
|
2649 and the string will be filled in properly in
|
|
|
2650 load_force_doc_string_unwind(). */
|
|
|
2651 Vload_force_doc_string_list =
|
|
|
2652 /* We pass the cons that holds the (#$ . INT) so we
|
|
|
2653 can modify it in-place. */
|
|
|
2654 Fcons (holding_cons, Vload_force_doc_string_list);
|
|
|
2655 }
|
|
|
2656 }
|
|
|
2657 }
|
|
|
2658
|
|
|
2659 UNGCPRO;
|
|
|
2660 return (s.head);
|
|
|
2661 }
|
|
|
2662
|
|
|
2663 static Lisp_Object
|
|
|
2664 read_vector (Lisp_Object readcharfun,
|
|
|
2665 Emchar terminator)
|
|
|
2666 {
|
|
|
2667 Lisp_Object tem;
|
|
|
2668 Lisp_Object *p;
|
|
|
2669 int len;
|
|
|
2670 int i;
|
|
|
2671 struct read_list_state s;
|
|
|
2672 struct gcpro gcpro1, gcpro2;
|
|
|
2673
|
|
|
2674
|
|
|
2675 s.head = Qnil;
|
|
|
2676 s.tail = Qnil;
|
|
|
2677 s.length = 0;
|
|
|
2678 s.allow_dotted_lists = 0;
|
|
|
2679 GCPRO2 (s.head, s.tail);
|
|
|
2680
|
|
|
2681 (void) sequence_reader (readcharfun,
|
|
|
2682 terminator,
|
|
|
2683 &s,
|
|
|
2684 read_list_conser);
|
|
|
2685 UNGCPRO;
|
|
|
2686 tem = s.head;
|
|
|
2687 len = XINT (Flength (tem));
|
|
|
2688
|
|
|
2689 #if 0 /* FSFmacs defun hack */
|
|
|
2690 if (read_pure)
|
|
|
2691 s.head = make_pure_vector (len, Qnil);
|
|
|
2692 else
|
|
|
2693 #endif
|
|
|
2694 s.head = make_vector (len, Qnil);
|
|
|
2695
|
|
|
2696 for (i = 0, p = &(vector_data (XVECTOR (s.head))[0]);
|
|
|
2697 i < len;
|
|
|
2698 i++, p++)
|
|
|
2699 {
|
|
|
2700 struct Lisp_Cons *otem = XCONS (tem);
|
|
|
2701 #if 0 /* FSFmacs defun hack */
|
|
|
2702 if (read_pure)
|
|
|
2703 tem = Fpurecopy (Fcar (tem));
|
|
|
2704 else
|
|
|
2705 #endif
|
|
|
2706 tem = Fcar (tem);
|
|
|
2707 *p = tem;
|
|
|
2708 tem = otem->cdr;
|
|
|
2709 free_cons (otem);
|
|
|
2710 }
|
|
|
2711 return (s.head);
|
|
|
2712 }
|
|
|
2713
|
|
|
2714 static Lisp_Object
|
|
|
2715 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
|
|
|
2716 {
|
|
|
2717 /* Accept compiled functions at read-time so that we don't
|
|
|
2718 have to build them at load-time. */
|
|
|
2719 Lisp_Object stuff;
|
|
|
2720 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
|
|
|
2721 struct gcpro gcpro1;
|
|
|
2722 int len;
|
|
|
2723 int iii;
|
|
|
2724 int saw_a_doc_ref = 0;
|
|
|
2725
|
|
|
2726 /* Note: we tell read_list not to search for doc references
|
|
|
2727 because we need to handle the "doc reference" for the
|
|
|
2728 instructions and constants differently. */
|
|
|
2729 stuff = read_list (readcharfun, terminator, 0, 0);
|
|
|
2730 len = XINT (Flength (stuff));
|
|
|
2731 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
|
|
|
2732 return
|
|
|
2733 continuable_syntax_error ("#[...] used with wrong number of elements");
|
|
|
2734
|
|
|
2735 for (iii = 0; CONSP (stuff); iii++)
|
|
|
2736 {
|
|
|
2737 struct Lisp_Cons *victim = XCONS (stuff);
|
|
|
2738 make_byte_code_args[iii] = Fcar (stuff);
|
|
|
2739 if ((purify_flag || load_force_doc_strings)
|
|
|
2740 && CONSP (make_byte_code_args[iii])
|
|
|
2741 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
|
|
|
2742 {
|
|
|
2743 if (purify_flag && iii == COMPILED_DOC_STRING)
|
|
|
2744 {
|
|
|
2745 /* same as in read_list(). */
|
|
|
2746 if (NILP (Vdoc_file_name))
|
|
|
2747 make_byte_code_args[iii] = Qzero;
|
|
|
2748 else
|
|
|
2749 XCAR (make_byte_code_args[iii]) =
|
|
|
2750 concat2 (build_string ("../lisp/"),
|
|
|
2751 Ffile_name_nondirectory
|
|
|
2752 (Vload_file_name_internal));
|
|
|
2753 }
|
|
|
2754 else
|
|
|
2755 saw_a_doc_ref = 1;
|
|
|
2756 }
|
|
|
2757 stuff = Fcdr (stuff);
|
|
|
2758 free_cons (victim);
|
|
|
2759 }
|
|
|
2760 GCPRO1 (make_byte_code_args[0]);
|
|
|
2761 gcpro1.nvars = len;
|
|
|
2762
|
|
|
2763 /* make-byte-code looks at purify_flag, which should have the same
|
|
|
2764 * value as our "read-pure" argument */
|
|
|
2765 stuff = Fmake_byte_code (len, make_byte_code_args);
|
|
|
2766 if (saw_a_doc_ref)
|
|
|
2767 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
|
|
|
2768 UNGCPRO;
|
|
|
2769 return stuff;
|
|
|
2770 }
|
|
|
2771
|
|
|
2772
|
|
|
2773
|
|
|
2774 void
|
|
|
2775 init_lread (void)
|
|
|
2776 {
|
|
|
2777 #ifdef PATH_LOADSEARCH
|
|
|
2778 CONST char *normal = PATH_LOADSEARCH;
|
|
|
2779
|
|
|
2780 /* Don't print this warning. If the hardcoded paths don't exist, then
|
|
|
2781 startup.el will try and deduce one. If it fails, it knows how to
|
|
|
2782 handle things. */
|
|
|
2783 #if 0
|
|
|
2784 #ifndef WINDOWSNT
|
|
|
2785 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
|
|
|
2786 almost never correct, thereby causing a warning to be printed out that
|
|
|
2787 confuses users. Since PATH_LOADSEARCH is always overriden by the
|
|
|
2788 EMACSLOADPATH environment variable below, disable the warning on NT. */
|
|
|
2789
|
|
|
2790 /* Warn if dirs in the *standard* path don't exist. */
|
|
|
2791 if (!turn_off_warning)
|
|
|
2792 {
|
|
|
2793 Lisp_Object normal_path = decode_env_path (0, normal);
|
|
|
2794 for (; !NILP (normal_path); normal_path = XCDR (normal_path))
|
|
|
2795 {
|
|
|
2796 Lisp_Object dirfile;
|
|
|
2797 dirfile = Fcar (normal_path);
|
|
|
2798 if (!NILP (dirfile))
|
|
|
2799 {
|
|
|
2800 dirfile = Fdirectory_file_name (dirfile);
|
|
|
2801 if (access ((char *) string_data (XSTRING (dirfile)), 0) < 0)
|
|
|
2802 stdout_out ("Warning: lisp library (%s) does not exist.\n",
|
|
|
2803 string_data (XSTRING (Fcar (normal_path))));
|
|
|
2804 }
|
|
|
2805 }
|
|
|
2806 }
|
|
|
2807 #endif /* WINDOWSNT */
|
|
|
2808 #endif /* 0 */
|
|
|
2809 #else /* !PATH_LOADSEARCH */
|
|
|
2810 CONST char *normal = 0;
|
|
|
2811 #endif /* !PATH_LOADSEARCH */
|
|
|
2812 Vvalues = Qnil;
|
|
|
2813
|
|
|
2814 /* further frobbed by startup.el if nil. */
|
|
|
2815 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
|
|
|
2816
|
|
|
2817 /* Vdump_load_path = Qnil; */
|
|
|
2818 #ifndef CANNOT_DUMP
|
|
|
2819 if (purify_flag && NILP (Vload_path))
|
|
|
2820 {
|
|
|
2821 /* loadup.el will frob this some more. */
|
|
|
2822 /* #### unix-specific */
|
|
|
2823 Vload_path = Fcons (build_string ("../lisp/prim"), Vload_path);
|
|
|
2824 }
|
|
|
2825 #endif /* not CANNOT_DUMP */
|
|
|
2826 load_in_progress = 0;
|
|
|
2827
|
|
|
2828 Vload_descriptor_list = Qnil;
|
|
|
2829
|
|
|
2830 Vread_buffer_stream = make_resizing_buffer_output_stream ();
|
|
|
2831
|
|
|
2832 Vload_force_doc_string_list = Qnil;
|
|
|
2833 }
|
|
|
2834
|
|
|
2835 void
|
|
|
2836 syms_of_lread (void)
|
|
|
2837 {
|
|
|
2838 defsubr (&Sread);
|
|
|
2839 defsubr (&Sread_from_string);
|
|
|
2840 defsubr (&Sload_internal);
|
|
|
2841 defsubr (&Slocate_file);
|
|
|
2842 defsubr (&Slocate_file_clear_hashing);
|
|
|
2843 defsubr (&Seval_buffer);
|
|
|
2844 defsubr (&Seval_region);
|
|
|
2845 #ifdef standalone
|
|
|
2846 defsubr (&Sread_char);
|
|
|
2847 #endif
|
|
|
2848
|
|
|
2849 defsymbol (&Qstandard_input, "standard-input");
|
|
|
2850 defsymbol (&Qread_char, "read-char");
|
|
|
2851 defsymbol (&Qcurrent_load_list, "current-load-list");
|
|
|
2852 defsymbol (&Qload, "load");
|
|
|
2853 defsymbol (&Qload_file_name, "load-file-name");
|
|
|
2854 defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table");
|
|
|
2855 defsymbol (&Qfset, "fset");
|
|
|
2856
|
|
|
2857 #ifdef LISP_BACKQUOTES
|
|
|
2858 defsymbol (&Qbackquote, "backquote");
|
|
|
2859 defsymbol (&Qbacktick, "`");
|
|
|
2860 defsymbol (&Qcomma, ",");
|
|
|
2861 defsymbol (&Qcomma_at, ",@");
|
|
|
2862 defsymbol (&Qcomma_dot, ",.");
|
|
|
2863 #endif
|
|
|
2864 }
|
|
|
2865
|
|
|
2866 void
|
|
|
2867 structure_type_create (void)
|
|
|
2868 {
|
|
|
2869 the_structure_type_dynarr = Dynarr_new (struct structure_type);
|
|
|
2870 }
|
|
|
2871
|
|
|
2872 void
|
|
|
2873 vars_of_lread (void)
|
|
|
2874 {
|
|
|
2875 DEFVAR_LISP ("values", &Vvalues /*
|
|
|
2876 List of values of all expressions which were read, evaluated and printed.
|
|
|
2877 Order is reverse chronological.
|
|
|
2878 */ );
|
|
|
2879
|
|
|
2880 DEFVAR_LISP ("standard-input", &Vstandard_input /*
|
|
|
2881 Stream for read to get input from.
|
|
|
2882 See documentation of `read' for possible values.
|
|
|
2883 */ );
|
|
|
2884 Vstandard_input = Qt;
|
|
|
2885
|
|
|
2886 DEFVAR_LISP ("load-path", &Vload_path /*
|
|
|
2887 *List of directories to search for files to load.
|
|
|
2888 Each element is a string (directory name) or nil (try default directory).
|
|
|
2889
|
|
|
2890 Note that the elements of this list *may not* begin with \"~\", so you must
|
|
|
2891 call `expand-file-name' on them before adding them to this list.
|
|
|
2892
|
|
|
2893 Initialized based on EMACSLOADPATH environment variable, if any,
|
|
|
2894 otherwise to default specified in by file `paths.h' when XEmacs was built.
|
|
|
2895 If there were no paths specified in `paths.h', then XEmacs chooses a default
|
|
|
2896 value for this variable by looking around in the file-system near the
|
|
|
2897 directory in which the XEmacs executable resides.
|
|
|
2898 */ );
|
|
|
2899
|
|
|
2900 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
|
|
|
2901 "*Location of lisp files to be used when dumping ONLY."); */
|
|
|
2902
|
|
|
2903 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
|
|
|
2904 Non-nil iff inside of `load'.
|
|
|
2905 */ );
|
|
|
2906
|
|
|
2907 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
|
|
|
2908 An alist of expressions to be evalled when particular files are loaded.
|
|
|
2909 Each element looks like (FILENAME FORMS...).
|
|
|
2910 When `load' is run and the file-name argument is FILENAME,
|
|
|
2911 the FORMS in the corresponding element are executed at the end of loading.
|
|
|
2912
|
|
|
2913 FILENAME must match exactly! Normally FILENAME is the name of a library,
|
|
|
2914 with no directory specified, since that is how `load' is normally called.
|
|
|
2915 An error in FORMS does not undo the load,
|
|
|
2916 but does prevent execution of the rest of the FORMS.
|
|
|
2917 */ );
|
|
|
2918 Vafter_load_alist = Qnil;
|
|
|
2919
|
|
|
2920 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
|
|
|
2921 *Whether `load' should check whether the source is newer than the binary.
|
|
|
2922 If this variable is true, then when a `.elc' file is being loaded and the
|
|
|
2923 corresponding `.el' is newer, a warning message will be printed.
|
|
|
2924 */ );
|
|
|
2925 load_warn_when_source_newer = 0;
|
|
|
2926
|
|
|
2927 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
|
|
|
2928 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
|
|
|
2929 If this variable is true, then when `load' is called with a filename without
|
|
|
2930 an extension, and the `.elc' version doesn't exist but the `.el' version does,
|
|
|
2931 then a message will be printed. If an explicit extension is passed to `load',
|
|
|
2932 no warning will be printed.
|
|
|
2933 */ );
|
|
|
2934 load_warn_when_source_only = 0;
|
|
|
2935
|
|
|
2936 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
|
|
|
2937 *Whether `load' should ignore `.elc' files when a suffix is not given.
|
|
|
2938 This is normally used only to bootstrap the `.elc' files when building XEmacs.
|
|
|
2939 */ );
|
|
|
2940 load_ignore_elc_files = 0;
|
|
|
2941
|
|
|
2942 #ifdef LOADHIST
|
|
|
2943 DEFVAR_LISP ("load-history", &Vload_history /*
|
|
|
2944 Alist mapping source file names to symbols and features.
|
|
|
2945 Each alist element is a list that starts with a file name,
|
|
|
2946 except for one element (optional) that starts with nil and describes
|
|
|
2947 definitions evaluated from buffers not visiting files.
|
|
|
2948 The remaining elements of each list are symbols defined as functions
|
|
|
2949 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
|
|
|
2950 */ );
|
|
|
2951 Vload_history = Qnil;
|
|
|
2952
|
|
|
2953 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
|
|
|
2954 Used for internal purposes by `load'.
|
|
|
2955 */ );
|
|
|
2956 Vcurrent_load_list = Qnil;
|
|
|
2957 #endif
|
|
|
2958
|
|
|
2959 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
|
|
|
2960 Full name of file being loaded by `load'.
|
|
|
2961 */ );
|
|
|
2962 Vload_file_name = Qnil;
|
|
|
2963
|
|
|
2964 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
|
|
|
2965 "Function used by `load' and `eval-region' for reading expressions.
|
|
|
2966 The default is nil, which means use the function `read'.
|
|
|
2967 */ );
|
|
|
2968 Vload_read_function = Qnil;
|
|
|
2969
|
|
|
2970 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
|
|
|
2971 Non-nil means `load' should force-load all dynamic doc strings.
|
|
|
2972 This is useful when the file being loaded is a temporary copy.
|
|
|
2973 */ );
|
|
|
2974 load_force_doc_strings = 0;
|
|
|
2975
|
|
|
2976 DEFVAR_LISP ("source-directory", &Vsource_directory /*
|
|
|
2977 Directory in which XEmacs sources were found when XEmacs was built.
|
|
|
2978 You cannot count on them to still be there!
|
|
|
2979 */ );
|
|
|
2980 Vsource_directory = Qnil;
|
|
|
2981
|
|
|
2982 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes", &puke_on_fsf_keys /*
|
|
|
2983 Whether `read' should signal an error when it encounters unsupported
|
|
|
2984 character escape syntaxes or just read them incorrectly.
|
|
|
2985 */ );
|
|
|
2986 puke_on_fsf_keys = 0;
|
|
|
2987
|
|
|
2988 /* This must be initialized in init_lread otherwise it may start out
|
|
|
2989 with values saved when the image is dumped. */
|
|
|
2990 staticpro (&Vload_descriptor_list);
|
|
|
2991
|
|
|
2992 /* This gets initialized in init_lread because all streams get closed
|
|
|
2993 when dumping occurs */
|
|
|
2994 staticpro (&Vread_buffer_stream);
|
|
|
2995
|
|
|
2996 /* Initialized in init_lread. */
|
|
|
2997 staticpro (&Vload_force_doc_string_list);
|
|
|
2998
|
|
|
2999 Vload_file_name_internal = Qnil;
|
|
|
3000 staticpro (&Vload_file_name_internal);
|
|
|
3001
|
|
|
3002 Vload_file_name_internal_the_purecopy = Qnil;
|
|
|
3003 staticpro (&Vload_file_name_internal_the_purecopy);
|
|
|
3004
|
|
|
3005 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
|
|
|
3006 Vcurrent_compiled_function_annotation = Qnil;
|
|
|
3007 staticpro (&Vcurrent_compiled_function_annotation);
|
|
|
3008 #endif
|
|
|
3009
|
|
|
3010 /* So that early-early stuff will work */
|
|
|
3011 Ffset (Qload, intern ("load-internal"));
|
|
|
3012
|
|
|
3013 #ifdef LISP_BACKQUOTES
|
|
|
3014 old_backquote_flag = new_backquote_flag = 0;
|
|
|
3015 #endif
|
|
|
3016
|
|
|
3017 #ifdef I18N3
|
|
|
3018 Vfile_domain = Qnil;
|
|
|
3019 #endif
|
|
|
3020 }
|
