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