1/* Lisp parsing and input streams. 2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 3 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4 2005, 2006, 2007 Free Software Foundation, Inc. 5 6This file is part of GNU Emacs. 7 8GNU Emacs is free software; you can redistribute it and/or modify 9it under the terms of the GNU General Public License as published by 10the Free Software Foundation; either version 2, or (at your option) 11any later version. 12 13GNU Emacs is distributed in the hope that it will be useful, 14but WITHOUT ANY WARRANTY; without even the implied warranty of 15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16GNU General Public License for more details. 17 18You should have received a copy of the GNU General Public License 19along with GNU Emacs; see the file COPYING. If not, write to 20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 21Boston, MA 02110-1301, USA. */ 22 23 24#include <config.h> 25#include <stdio.h> 26#include <sys/types.h> 27#include <sys/stat.h> 28#include <sys/file.h> 29#include <errno.h> 30#include "lisp.h" 31#include "intervals.h" 32#include "buffer.h" 33#include "charset.h" 34#include <epaths.h> 35#include "commands.h" 36#include "keyboard.h" 37#include "termhooks.h" 38#include "coding.h" 39#include "blockinput.h" 40 41#ifdef lint 42#include <sys/inode.h> 43#endif /* lint */ 44 45#ifdef MSDOS 46#if __DJGPP__ < 2 47#include <unistd.h> /* to get X_OK */ 48#endif 49#include "msdos.h" 50#endif 51 52#ifdef HAVE_UNISTD_H 53#include <unistd.h> 54#endif 55 56#ifndef X_OK 57#define X_OK 01 58#endif 59 60#include <math.h> 61 62#ifdef HAVE_SETLOCALE 63#include <locale.h> 64#endif /* HAVE_SETLOCALE */ 65 66#ifdef HAVE_FCNTL_H 67#include <fcntl.h> 68#endif 69#ifndef O_RDONLY 70#define O_RDONLY 0 71#endif 72 73#ifdef HAVE_FSEEKO 74#define file_offset off_t 75#define file_tell ftello 76#else 77#define file_offset long 78#define file_tell ftell 79#endif 80 81#ifndef USE_CRT_DLL 82extern int errno; 83#endif 84 85Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list; 86Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; 87Lisp_Object Qascii_character, Qload, Qload_file_name; 88Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; 89Lisp_Object Qinhibit_file_name_operation; 90Lisp_Object Qeval_buffer_list, Veval_buffer_list; 91Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ 92 93extern Lisp_Object Qevent_symbol_element_mask; 94extern Lisp_Object Qfile_exists_p; 95 96/* non-zero iff inside `load' */ 97int load_in_progress; 98 99/* Directory in which the sources were found. */ 100Lisp_Object Vsource_directory; 101 102/* Search path and suffixes for files to be loaded. */ 103Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes; 104 105/* File name of user's init file. */ 106Lisp_Object Vuser_init_file; 107 108/* This is the user-visible association list that maps features to 109 lists of defs in their load files. */ 110Lisp_Object Vload_history; 111 112/* This is used to build the load history. */ 113Lisp_Object Vcurrent_load_list; 114 115/* List of files that were preloaded. */ 116Lisp_Object Vpreloaded_file_list; 117 118/* Name of file actually being read by `load'. */ 119Lisp_Object Vload_file_name; 120 121/* Function to use for reading, in `load' and friends. */ 122Lisp_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. */ 128Lisp_Object read_objects; 129 130/* Nonzero means load should forcibly load all dynamic doc strings. */ 131static int load_force_doc_strings; 132 133/* Nonzero means read should convert strings to unibyte. */ 134static int load_convert_to_unibyte; 135 136/* Function to use for loading an Emacs Lisp source file (not 137 compiled) instead of readevalloop. */ 138Lisp_Object Vload_source_file_function; 139 140/* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */ 141Lisp_Object Vbyte_boolean_vars; 142 143/* Whether or not to add a `read-positions' property to symbols 144 read. */ 145Lisp_Object Vread_with_symbol_positions; 146 147/* List of (SYMBOL . POSITION) accumulated so far. */ 148Lisp_Object Vread_symbol_positions_list; 149 150/* List of descriptors now open for Fload. */ 151static Lisp_Object load_descriptor_list; 152 153/* File for get_file_char to read from. Use by load. */ 154static FILE *instream; 155 156/* When nonzero, read conses in pure space */ 157static int read_pure; 158 159/* For use within read-from-string (this reader is non-reentrant!!) */ 160static int read_from_string_index; 161static int read_from_string_index_byte; 162static int read_from_string_limit; 163 164/* Number of bytes left to read in the buffer character 165 that `readchar' has already advanced over. */ 166static int readchar_backlog; 167/* Number of characters read in the current call to Fread or 168 Fread_from_string. */ 169static int readchar_count; 170 171/* This contains the last string skipped with #@. */ 172static char *saved_doc_string; 173/* Length of buffer allocated in saved_doc_string. */ 174static int saved_doc_string_size; 175/* Length of actual data in saved_doc_string. */ 176static int saved_doc_string_length; 177/* This is the file position that string came from. */ 178static file_offset saved_doc_string_position; 179 180/* This contains the previous string skipped with #@. 181 We copy it from saved_doc_string when a new string 182 is put in saved_doc_string. */ 183static char *prev_saved_doc_string; 184/* Length of buffer allocated in prev_saved_doc_string. */ 185static int prev_saved_doc_string_size; 186/* Length of actual data in prev_saved_doc_string. */ 187static int prev_saved_doc_string_length; 188/* This is the file position that string came from. */ 189static file_offset prev_saved_doc_string_position; 190 191/* Nonzero means inside a new-style backquote 192 with no surrounding parentheses. 193 Fread initializes this to zero, so we need not specbind it 194 or worry about what happens to it when there is an error. */ 195static int new_backquote_flag; 196 197/* A list of file names for files being loaded in Fload. Used to 198 check for recursive loads. */ 199 200static Lisp_Object Vloads_in_progress; 201 202/* Non-zero means load dangerous compiled Lisp files. */ 203 204int load_dangerous_libraries; 205 206/* A regular expression used to detect files compiled with Emacs. */ 207 208static Lisp_Object Vbytecomp_version_regexp; 209 210static void to_multibyte P_ ((char **, char **, int *)); 211static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, 212 Lisp_Object (*) (), int, 213 Lisp_Object, Lisp_Object, 214 Lisp_Object, Lisp_Object)); 215static Lisp_Object load_unwind P_ ((Lisp_Object)); 216static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); 217 218static void invalid_syntax P_ ((const char *, int)) NO_RETURN; 219static void end_of_file_error P_ (()) NO_RETURN; 220 221 222/* Handle unreading and rereading of characters. 223 Write READCHAR to read a character, 224 UNREAD(c) to unread c to be read again. 225 226 The READCHAR and UNREAD macros are meant for reading/unreading a 227 byte code; they do not handle multibyte characters. The caller 228 should manage them if necessary. 229 230 [ Actually that seems to be a lie; READCHAR will definitely read 231 multibyte characters from buffer sources, at least. Is the 232 comment just out of date? 233 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ] 234 */ 235 236#define READCHAR readchar (readcharfun) 237#define UNREAD(c) unreadchar (readcharfun, c) 238 239static int 240readchar (readcharfun) 241 Lisp_Object readcharfun; 242{ 243 Lisp_Object tem; 244 register int c; 245 246 readchar_count++; 247 248 if (BUFFERP (readcharfun)) 249 { 250 register struct buffer *inbuffer = XBUFFER (readcharfun); 251 252 int pt_byte = BUF_PT_BYTE (inbuffer); 253 int orig_pt_byte = pt_byte; 254 255 if (readchar_backlog > 0) 256 /* We get the address of the byte just passed, 257 which is the last byte of the character. 258 The other bytes in this character are consecutive with it, 259 because the gap can't be in the middle of a character. */ 260 return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1) 261 - --readchar_backlog); 262 263 if (pt_byte >= BUF_ZV_BYTE (inbuffer)) 264 return -1; 265 266 readchar_backlog = -1; 267 268 if (! NILP (inbuffer->enable_multibyte_characters)) 269 { 270 /* Fetch the character code from the buffer. */ 271 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); 272 BUF_INC_POS (inbuffer, pt_byte); 273 c = STRING_CHAR (p, pt_byte - orig_pt_byte); 274 } 275 else 276 { 277 c = BUF_FETCH_BYTE (inbuffer, pt_byte); 278 pt_byte++; 279 } 280 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte); 281 282 return c; 283 } 284 if (MARKERP (readcharfun)) 285 { 286 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer; 287 288 int bytepos = marker_byte_position (readcharfun); 289 int orig_bytepos = bytepos; 290 291 if (readchar_backlog > 0) 292 /* We get the address of the byte just passed, 293 which is the last byte of the character. 294 The other bytes in this character are consecutive with it, 295 because the gap can't be in the middle of a character. */ 296 return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1) 297 - --readchar_backlog); 298 299 if (bytepos >= BUF_ZV_BYTE (inbuffer)) 300 return -1; 301 302 readchar_backlog = -1; 303 304 if (! NILP (inbuffer->enable_multibyte_characters)) 305 { 306 /* Fetch the character code from the buffer. */ 307 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); 308 BUF_INC_POS (inbuffer, bytepos); 309 c = STRING_CHAR (p, bytepos - orig_bytepos); 310 } 311 else 312 { 313 c = BUF_FETCH_BYTE (inbuffer, bytepos); 314 bytepos++; 315 } 316 317 XMARKER (readcharfun)->bytepos = bytepos; 318 XMARKER (readcharfun)->charpos++; 319 320 return c; 321 } 322 323 if (EQ (readcharfun, Qlambda)) 324 return read_bytecode_char (0); 325 326 if (EQ (readcharfun, Qget_file_char)) 327 { 328 BLOCK_INPUT; 329 c = getc (instream); 330#ifdef EINTR 331 /* Interrupted reads have been observed while reading over the network */ 332 while (c == EOF && ferror (instream) && errno == EINTR) 333 { 334 UNBLOCK_INPUT; 335 QUIT; 336 BLOCK_INPUT; 337 clearerr (instream); 338 c = getc (instream); 339 } 340#endif 341 UNBLOCK_INPUT; 342 return c; 343 } 344 345 if (STRINGP (readcharfun)) 346 { 347 if (read_from_string_index >= read_from_string_limit) 348 c = -1; 349 else 350 FETCH_STRING_CHAR_ADVANCE (c, readcharfun, 351 read_from_string_index, 352 read_from_string_index_byte); 353 354 return c; 355 } 356 357 tem = call0 (readcharfun); 358 359 if (NILP (tem)) 360 return -1; 361 return XINT (tem); 362} 363 364/* Unread the character C in the way appropriate for the stream READCHARFUN. 365 If the stream is a user function, call it with the char as argument. */ 366 367static void 368unreadchar (readcharfun, c) 369 Lisp_Object readcharfun; 370 int c; 371{ 372 readchar_count--; 373 if (c == -1) 374 /* Don't back up the pointer if we're unreading the end-of-input mark, 375 since readchar didn't advance it when we read it. */ 376 ; 377 else if (BUFFERP (readcharfun)) 378 { 379 struct buffer *b = XBUFFER (readcharfun); 380 int bytepos = BUF_PT_BYTE (b); 381 382 if (readchar_backlog >= 0) 383 readchar_backlog++; 384 else 385 { 386 BUF_PT (b)--; 387 if (! NILP (b->enable_multibyte_characters)) 388 BUF_DEC_POS (b, bytepos); 389 else 390 bytepos--; 391 392 BUF_PT_BYTE (b) = bytepos; 393 } 394 } 395 else if (MARKERP (readcharfun)) 396 { 397 struct buffer *b = XMARKER (readcharfun)->buffer; 398 int bytepos = XMARKER (readcharfun)->bytepos; 399 400 if (readchar_backlog >= 0) 401 readchar_backlog++; 402 else 403 { 404 XMARKER (readcharfun)->charpos--; 405 if (! NILP (b->enable_multibyte_characters)) 406 BUF_DEC_POS (b, bytepos); 407 else 408 bytepos--; 409 410 XMARKER (readcharfun)->bytepos = bytepos; 411 } 412 } 413 else if (STRINGP (readcharfun)) 414 { 415 read_from_string_index--; 416 read_from_string_index_byte 417 = string_char_to_byte (readcharfun, read_from_string_index); 418 } 419 else if (EQ (readcharfun, Qlambda)) 420 read_bytecode_char (1); 421 else if (EQ (readcharfun, Qget_file_char)) 422 { 423 BLOCK_INPUT; 424 ungetc (c, instream); 425 UNBLOCK_INPUT; 426 } 427 else 428 call1 (readcharfun, make_number (c)); 429} 430 431static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object, 432 Lisp_Object)); 433static Lisp_Object read0 P_ ((Lisp_Object)); 434static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); 435 436static Lisp_Object read_list P_ ((int, Lisp_Object)); 437static Lisp_Object read_vector P_ ((Lisp_Object, int)); 438static int read_multibyte P_ ((int, Lisp_Object)); 439 440static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object, 441 Lisp_Object)); 442static void substitute_object_in_subtree P_ ((Lisp_Object, 443 Lisp_Object)); 444static void substitute_in_interval P_ ((INTERVAL, Lisp_Object)); 445 446 447/* Get a character from the tty. */ 448 449extern Lisp_Object read_char (); 450 451/* Read input events until we get one that's acceptable for our purposes. 452 453 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed 454 until we get a character we like, and then stuffed into 455 unread_switch_frame. 456 457 If ASCII_REQUIRED is non-zero, we check function key events to see 458 if the unmodified version of the symbol has a Qascii_character 459 property, and use that character, if present. 460 461 If ERROR_NONASCII is non-zero, we signal an error if the input we 462 get isn't an ASCII character with modifiers. If it's zero but 463 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII 464 character. 465 466 If INPUT_METHOD is nonzero, we invoke the current input method 467 if the character warrants that. 468 469 If SECONDS is a number, we wait that many seconds for input, and 470 return Qnil if no input arrives within that time. */ 471 472Lisp_Object 473read_filtered_event (no_switch_frame, ascii_required, error_nonascii, 474 input_method, seconds) 475 int no_switch_frame, ascii_required, error_nonascii, input_method; 476 Lisp_Object seconds; 477{ 478 Lisp_Object val, delayed_switch_frame; 479 EMACS_TIME end_time; 480 481#ifdef HAVE_WINDOW_SYSTEM 482 if (display_hourglass_p) 483 cancel_hourglass (); 484#endif 485 486 delayed_switch_frame = Qnil; 487 488 /* Compute timeout. */ 489 if (NUMBERP (seconds)) 490 { 491 EMACS_TIME wait_time; 492 int sec, usec; 493 double duration = extract_float (seconds); 494 495 sec = (int) duration; 496 usec = (duration - sec) * 1000000; 497 EMACS_GET_TIME (end_time); 498 EMACS_SET_SECS_USECS (wait_time, sec, usec); 499 EMACS_ADD_TIME (end_time, end_time, wait_time); 500 } 501 502 /* Read until we get an acceptable event. */ 503 retry: 504 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0, 505 NUMBERP (seconds) ? &end_time : NULL); 506 507 if (BUFFERP (val)) 508 goto retry; 509 510 /* switch-frame events are put off until after the next ASCII 511 character. This is better than signaling an error just because 512 the last characters were typed to a separate minibuffer frame, 513 for example. Eventually, some code which can deal with 514 switch-frame events will read it and process it. */ 515 if (no_switch_frame 516 && EVENT_HAS_PARAMETERS (val) 517 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame)) 518 { 519 delayed_switch_frame = val; 520 goto retry; 521 } 522 523 if (ascii_required && !(NUMBERP (seconds) && NILP (val))) 524 { 525 /* Convert certain symbols to their ASCII equivalents. */ 526 if (SYMBOLP (val)) 527 { 528 Lisp_Object tem, tem1; 529 tem = Fget (val, Qevent_symbol_element_mask); 530 if (!NILP (tem)) 531 { 532 tem1 = Fget (Fcar (tem), Qascii_character); 533 /* Merge this symbol's modifier bits 534 with the ASCII equivalent of its basic code. */ 535 if (!NILP (tem1)) 536 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem)))); 537 } 538 } 539 540 /* If we don't have a character now, deal with it appropriately. */ 541 if (!INTEGERP (val)) 542 { 543 if (error_nonascii) 544 { 545 Vunread_command_events = Fcons (val, Qnil); 546 error ("Non-character input-event"); 547 } 548 else 549 goto retry; 550 } 551 } 552 553 if (! NILP (delayed_switch_frame)) 554 unread_switch_frame = delayed_switch_frame; 555 556#if 0 557 558#ifdef HAVE_WINDOW_SYSTEM 559 if (display_hourglass_p) 560 start_hourglass (); 561#endif 562 563#endif 564 565 return val; 566} 567 568DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0, 569 doc: /* Read a character from the command input (keyboard or macro). 570It is returned as a number. 571If the user generates an event which is not a character (i.e. a mouse 572click or function key event), `read-char' signals an error. As an 573exception, switch-frame events are put off until non-ASCII events can 574be read. 575If you want to read non-character events, or ignore them, call 576`read-event' or `read-char-exclusive' instead. 577 578If the optional argument PROMPT is non-nil, display that as a prompt. 579If the optional argument INHERIT-INPUT-METHOD is non-nil and some 580input method is turned on in the current buffer, that input method 581is used for reading a character. 582If the optional argument SECONDS is non-nil, it should be a number 583specifying the maximum number of seconds to wait for input. If no 584input arrives in that time, return nil. SECONDS may be a 585floating-point value. */) 586 (prompt, inherit_input_method, seconds) 587 Lisp_Object prompt, inherit_input_method, seconds; 588{ 589 if (! NILP (prompt)) 590 message_with_string ("%s", prompt, 0); 591 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds); 592} 593 594DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0, 595 doc: /* Read an event object from the input stream. 596If the optional argument PROMPT is non-nil, display that as a prompt. 597If the optional argument INHERIT-INPUT-METHOD is non-nil and some 598input method is turned on in the current buffer, that input method 599is used for reading a character. 600If the optional argument SECONDS is non-nil, it should be a number 601specifying the maximum number of seconds to wait for input. If no 602input arrives in that time, return nil. SECONDS may be a 603floating-point value. */) 604 (prompt, inherit_input_method, seconds) 605 Lisp_Object prompt, inherit_input_method, seconds; 606{ 607 if (! NILP (prompt)) 608 message_with_string ("%s", prompt, 0); 609 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds); 610} 611 612DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0, 613 doc: /* Read a character from the command input (keyboard or macro). 614It is returned as a number. Non-character events are ignored. 615 616If the optional argument PROMPT is non-nil, display that as a prompt. 617If the optional argument INHERIT-INPUT-METHOD is non-nil and some 618input method is turned on in the current buffer, that input method 619is used for reading a character. 620If the optional argument SECONDS is non-nil, it should be a number 621specifying the maximum number of seconds to wait for input. If no 622input arrives in that time, return nil. SECONDS may be a 623floating-point value. */) 624 (prompt, inherit_input_method, seconds) 625 Lisp_Object prompt, inherit_input_method, seconds; 626{ 627 if (! NILP (prompt)) 628 message_with_string ("%s", prompt, 0); 629 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds); 630} 631 632DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, 633 doc: /* Don't use this yourself. */) 634 () 635{ 636 register Lisp_Object val; 637 BLOCK_INPUT; 638 XSETINT (val, getc (instream)); 639 UNBLOCK_INPUT; 640 return val; 641} 642 643 644 645/* Value is non-zero if the file asswociated with file descriptor FD 646 is a compiled Lisp file that's safe to load. Only files compiled 647 with Emacs are safe to load. Files compiled with XEmacs can lead 648 to a crash in Fbyte_code because of an incompatible change in the 649 byte compiler. */ 650 651static int 652safe_to_load_p (fd) 653 int fd; 654{ 655 char buf[512]; 656 int nbytes, i; 657 int safe_p = 1; 658 659 /* Read the first few bytes from the file, and look for a line 660 specifying the byte compiler version used. */ 661 nbytes = emacs_read (fd, buf, sizeof buf - 1); 662 if (nbytes > 0) 663 { 664 buf[nbytes] = '\0'; 665 666 /* Skip to the next newline, skipping over the initial `ELC' 667 with NUL bytes following it. */ 668 for (i = 0; i < nbytes && buf[i] != '\n'; ++i) 669 ; 670 671 if (i < nbytes 672 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp, 673 buf + i) < 0) 674 safe_p = 0; 675 } 676 677 lseek (fd, 0, SEEK_SET); 678 return safe_p; 679} 680 681 682/* Callback for record_unwind_protect. Restore the old load list OLD, 683 after loading a file successfully. */ 684 685static Lisp_Object 686record_load_unwind (old) 687 Lisp_Object old; 688{ 689 return Vloads_in_progress = old; 690} 691 692/* This handler function is used via internal_condition_case_1. */ 693 694static Lisp_Object 695load_error_handler (data) 696 Lisp_Object data; 697{ 698 return Qnil; 699} 700 701DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, 702 doc: /* Return the suffixes that `load' should try if a suffix is \ 703required. 704This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) 705 () 706{ 707 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; 708 while (CONSP (suffixes)) 709 { 710 Lisp_Object exts = Vload_file_rep_suffixes; 711 suffix = XCAR (suffixes); 712 suffixes = XCDR (suffixes); 713 while (CONSP (exts)) 714 { 715 ext = XCAR (exts); 716 exts = XCDR (exts); 717 lst = Fcons (concat2 (suffix, ext), lst); 718 } 719 } 720 return Fnreverse (lst); 721} 722 723DEFUN ("load", Fload, Sload, 1, 5, 0, 724 doc: /* Execute a file of Lisp code named FILE. 725First try FILE with `.elc' appended, then try with `.el', 726then try FILE unmodified (the exact suffixes in the exact order are 727determined by `load-suffixes'). Environment variable references in 728FILE are replaced with their values by calling `substitute-in-file-name'. 729This function searches the directories in `load-path'. 730 731If optional second arg NOERROR is non-nil, 732report no error if FILE doesn't exist. 733Print messages at start and end of loading unless 734optional third arg NOMESSAGE is non-nil. 735If optional fourth arg NOSUFFIX is non-nil, don't try adding 736suffixes `.elc' or `.el' to the specified name FILE. 737If optional fifth arg MUST-SUFFIX is non-nil, insist on 738the suffix `.elc' or `.el'; don't accept just FILE unless 739it ends in one of those suffixes or includes a directory name. 740 741If this function fails to find a file, it may look for different 742representations of that file before trying another file. 743It does so by adding the non-empty suffixes in `load-file-rep-suffixes' 744to the file name. Emacs uses this feature mainly to find compressed 745versions of files when Auto Compression mode is enabled. 746 747The exact suffixes that this function tries out, in the exact order, 748are given by the value of the variable `load-file-rep-suffixes' if 749NOSUFFIX is non-nil and by the return value of the function 750`get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and 751MUST-SUFFIX are nil, this function first tries out the latter suffixes 752and then the former. 753 754Loading a file records its definitions, and its `provide' and 755`require' calls, in an element of `load-history' whose 756car is the file name loaded. See `load-history'. 757 758Return t if the file exists and loads successfully. */) 759 (file, noerror, nomessage, nosuffix, must_suffix) 760 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix; 761{ 762 register FILE *stream; 763 register int fd = -1; 764 int count = SPECPDL_INDEX (); 765 Lisp_Object temp; 766 struct gcpro gcpro1, gcpro2, gcpro3; 767 Lisp_Object found, efound, hist_file_name; 768 /* 1 means we printed the ".el is newer" message. */ 769 int newer = 0; 770 /* 1 means we are loading a compiled file. */ 771 int compiled = 0; 772 Lisp_Object handler; 773 int safe_p = 1; 774 char *fmode = "r"; 775 Lisp_Object tmp[2]; 776#ifdef DOS_NT 777 fmode = "rt"; 778#endif /* DOS_NT */ 779 780 CHECK_STRING (file); 781 782 /* If file name is magic, call the handler. */ 783 /* This shouldn't be necessary any more now that `openp' handles it right. 784 handler = Ffind_file_name_handler (file, Qload); 785 if (!NILP (handler)) 786 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */ 787 788 /* Do this after the handler to avoid 789 the need to gcpro noerror, nomessage and nosuffix. 790 (Below here, we care only whether they are nil or not.) 791 The presence of this call is the result of a historical accident: 792 it used to be in every file-operation and when it got removed 793 everywhere, it accidentally stayed here. Since then, enough people 794 supposedly have things like (load "$PROJECT/foo.el") in their .emacs 795 that it seemed risky to remove. */ 796 if (! NILP (noerror)) 797 { 798 file = internal_condition_case_1 (Fsubstitute_in_file_name, file, 799 Qt, load_error_handler); 800 if (NILP (file)) 801 return Qnil; 802 } 803 else 804 file = Fsubstitute_in_file_name (file); 805 806 807 /* Avoid weird lossage with null string as arg, 808 since it would try to load a directory as a Lisp file */ 809 if (SCHARS (file) > 0) 810 { 811 int size = SBYTES (file); 812 813 found = Qnil; 814 GCPRO2 (file, found); 815 816 if (! NILP (must_suffix)) 817 { 818 /* Don't insist on adding a suffix if FILE already ends with one. */ 819 if (size > 3 820 && !strcmp (SDATA (file) + size - 3, ".el")) 821 must_suffix = Qnil; 822 else if (size > 4 823 && !strcmp (SDATA (file) + size - 4, ".elc")) 824 must_suffix = Qnil; 825 /* Don't insist on adding a suffix 826 if the argument includes a directory name. */ 827 else if (! NILP (Ffile_name_directory (file))) 828 must_suffix = Qnil; 829 } 830 831 fd = openp (Vload_path, file, 832 (!NILP (nosuffix) ? Qnil 833 : !NILP (must_suffix) ? Fget_load_suffixes () 834 : Fappend (2, (tmp[0] = Fget_load_suffixes (), 835 tmp[1] = Vload_file_rep_suffixes, 836 tmp))), 837 &found, Qnil); 838 UNGCPRO; 839 } 840 841 if (fd == -1) 842 { 843 if (NILP (noerror)) 844 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file); 845 return Qnil; 846 } 847 848 /* Tell startup.el whether or not we found the user's init file. */ 849 if (EQ (Qt, Vuser_init_file)) 850 Vuser_init_file = found; 851 852 /* If FD is -2, that means openp found a magic file. */ 853 if (fd == -2) 854 { 855 if (NILP (Fequal (found, file))) 856 /* If FOUND is a different file name from FILE, 857 find its handler even if we have already inhibited 858 the `load' operation on FILE. */ 859 handler = Ffind_file_name_handler (found, Qt); 860 else 861 handler = Ffind_file_name_handler (found, Qload); 862 if (! NILP (handler)) 863 return call5 (handler, Qload, found, noerror, nomessage, Qt); 864 } 865 866 /* Check if we're stuck in a recursive load cycle. 867 868 2000-09-21: It's not possible to just check for the file loaded 869 being a member of Vloads_in_progress. This fails because of the 870 way the byte compiler currently works; `provide's are not 871 evaluted, see font-lock.el/jit-lock.el as an example. This 872 leads to a certain amount of ``normal'' recursion. 873 874 Also, just loading a file recursively is not always an error in 875 the general case; the second load may do something different. */ 876 { 877 int count = 0; 878 Lisp_Object tem; 879 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem)) 880 if (!NILP (Fequal (found, XCAR (tem)))) 881 count++; 882 if (count > 3) 883 { 884 if (fd >= 0) 885 emacs_close (fd); 886 signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); 887 } 888 record_unwind_protect (record_load_unwind, Vloads_in_progress); 889 Vloads_in_progress = Fcons (found, Vloads_in_progress); 890 } 891 892 /* Get the name for load-history. */ 893 hist_file_name = (! NILP (Vpurify_flag) 894 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file), 895 tmp[1] = Ffile_name_nondirectory (found), 896 tmp)) 897 : found) ; 898 899 if (!bcmp (SDATA (found) + SBYTES (found) - 4, 900 ".elc", 4)) 901 /* Load .elc files directly, but not when they are 902 remote and have no handler! */ 903 { 904 if (fd != -2) 905 { 906 struct stat s1, s2; 907 int result; 908 909 GCPRO3 (file, found, hist_file_name); 910 911 if (!safe_to_load_p (fd)) 912 { 913 safe_p = 0; 914 if (!load_dangerous_libraries) 915 { 916 if (fd >= 0) 917 emacs_close (fd); 918 error ("File `%s' was not compiled in Emacs", 919 SDATA (found)); 920 } 921 else if (!NILP (nomessage)) 922 message_with_string ("File `%s' not compiled in Emacs", found, 1); 923 } 924 925 compiled = 1; 926 927 efound = ENCODE_FILE (found); 928 929#ifdef DOS_NT 930 fmode = "rb"; 931#endif /* DOS_NT */ 932 stat ((char *)SDATA (efound), &s1); 933 SSET (efound, SBYTES (efound) - 1, 0); 934 result = stat ((char *)SDATA (efound), &s2); 935 SSET (efound, SBYTES (efound) - 1, 'c'); 936 937 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) 938 { 939 /* Make the progress messages mention that source is newer. */ 940 newer = 1; 941 942 /* If we won't print another message, mention this anyway. */ 943 if (!NILP (nomessage)) 944 { 945 Lisp_Object msg_file; 946 msg_file = Fsubstring (found, make_number (0), make_number (-1)); 947 message_with_string ("Source file `%s' newer than byte-compiled file", 948 msg_file, 1); 949 } 950 } 951 UNGCPRO; 952 } 953 } 954 else 955 { 956 /* We are loading a source file (*.el). */ 957 if (!NILP (Vload_source_file_function)) 958 { 959 Lisp_Object val; 960 961 if (fd >= 0) 962 emacs_close (fd); 963 val = call4 (Vload_source_file_function, found, hist_file_name, 964 NILP (noerror) ? Qnil : Qt, 965 NILP (nomessage) ? Qnil : Qt); 966 return unbind_to (count, val); 967 } 968 } 969 970 GCPRO3 (file, found, hist_file_name); 971 972#ifdef WINDOWSNT 973 emacs_close (fd); 974 efound = ENCODE_FILE (found); 975 stream = fopen ((char *) SDATA (efound), fmode); 976#else /* not WINDOWSNT */ 977 stream = fdopen (fd, fmode); 978#endif /* not WINDOWSNT */ 979 if (stream == 0) 980 { 981 emacs_close (fd); 982 error ("Failure to create stdio stream for %s", SDATA (file)); 983 } 984 985 if (! NILP (Vpurify_flag)) 986 Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list); 987 988 if (NILP (nomessage)) 989 { 990 if (!safe_p) 991 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...", 992 file, 1); 993 else if (!compiled) 994 message_with_string ("Loading %s (source)...", file, 1); 995 else if (newer) 996 message_with_string ("Loading %s (compiled; note, source file is newer)...", 997 file, 1); 998 else /* The typical case; compiled file newer than source file. */ 999 message_with_string ("Loading %s...", file, 1); 1000 } 1001 1002 record_unwind_protect (load_unwind, make_save_value (stream, 0)); 1003 record_unwind_protect (load_descriptor_unwind, load_descriptor_list); 1004 specbind (Qload_file_name, found); 1005 specbind (Qinhibit_file_name_operation, Qnil); 1006 load_descriptor_list 1007 = Fcons (make_number (fileno (stream)), load_descriptor_list); 1008 load_in_progress++; 1009 readevalloop (Qget_file_char, stream, hist_file_name, 1010 Feval, 0, Qnil, Qnil, Qnil, Qnil); 1011 unbind_to (count, Qnil); 1012 1013 /* Run any eval-after-load forms for this file */ 1014 if (NILP (Vpurify_flag) 1015 && (!NILP (Ffboundp (Qdo_after_load_evaluation)))) 1016 call1 (Qdo_after_load_evaluation, hist_file_name) ; 1017 1018 UNGCPRO; 1019 1020 if (saved_doc_string) 1021 free (saved_doc_string); 1022 saved_doc_string = 0; 1023 saved_doc_string_size = 0; 1024 1025 if (prev_saved_doc_string) 1026 xfree (prev_saved_doc_string); 1027 prev_saved_doc_string = 0; 1028 prev_saved_doc_string_size = 0; 1029 1030 if (!noninteractive && NILP (nomessage)) 1031 { 1032 if (!safe_p) 1033 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done", 1034 file, 1); 1035 else if (!compiled) 1036 message_with_string ("Loading %s (source)...done", file, 1); 1037 else if (newer) 1038 message_with_string ("Loading %s (compiled; note, source file is newer)...done", 1039 file, 1); 1040 else /* The typical case; compiled file newer than source file. */ 1041 message_with_string ("Loading %s...done", file, 1); 1042 } 1043 1044 if (!NILP (Fequal (build_string ("obsolete"), 1045 Ffile_name_nondirectory 1046 (Fdirectory_file_name (Ffile_name_directory (found)))))) 1047 message_with_string ("Package %s is obsolete", file, 1); 1048 1049 return Qt; 1050} 1051 1052static Lisp_Object 1053load_unwind (arg) /* used as unwind-protect function in load */ 1054 Lisp_Object arg; 1055{ 1056 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; 1057 if (stream != NULL) 1058 { 1059 BLOCK_INPUT; 1060 fclose (stream); 1061 UNBLOCK_INPUT; 1062 } 1063 if (--load_in_progress < 0) load_in_progress = 0; 1064 return Qnil; 1065} 1066 1067static Lisp_Object 1068load_descriptor_unwind (oldlist) 1069 Lisp_Object oldlist; 1070{ 1071 load_descriptor_list = oldlist; 1072 return Qnil; 1073} 1074 1075/* Close all descriptors in use for Floads. 1076 This is used when starting a subprocess. */ 1077 1078void 1079close_load_descs () 1080{ 1081#ifndef WINDOWSNT 1082 Lisp_Object tail; 1083 for (tail = load_descriptor_list; !NILP (tail); tail = XCDR (tail)) 1084 emacs_close (XFASTINT (XCAR (tail))); 1085#endif 1086} 1087 1088static int 1089complete_filename_p (pathname) 1090 Lisp_Object pathname; 1091{ 1092 register const unsigned char *s = SDATA (pathname); 1093 return (IS_DIRECTORY_SEP (s[0]) 1094 || (SCHARS (pathname) > 2 1095 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])) 1096#ifdef ALTOS 1097 || *s == '@' 1098#endif 1099#ifdef VMS 1100 || index (s, ':') 1101#endif /* VMS */ 1102 ); 1103} 1104 1105DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0, 1106 doc: /* Search for FILENAME through PATH. 1107Returns the file's name in absolute form, or nil if not found. 1108If SUFFIXES is non-nil, it should be a list of suffixes to append to 1109file name when searching. 1110If non-nil, PREDICATE is used instead of `file-readable-p'. 1111PREDICATE can also be an integer to pass to the access(2) function, 1112in which case file-name-handlers are ignored. */) 1113 (filename, path, suffixes, predicate) 1114 Lisp_Object filename, path, suffixes, predicate; 1115{ 1116 Lisp_Object file; 1117 int fd = openp (path, filename, suffixes, &file, predicate); 1118 if (NILP (predicate) && fd > 0) 1119 close (fd); 1120 return file; 1121} 1122 1123 1124/* Search for a file whose name is STR, looking in directories 1125 in the Lisp list PATH, and trying suffixes from SUFFIX. 1126 On success, returns a file descriptor. On failure, returns -1. 1127 1128 SUFFIXES is a list of strings containing possible suffixes. 1129 The empty suffix is automatically added iff the list is empty. 1130 1131 PREDICATE non-nil means don't open the files, 1132 just look for one that satisfies the predicate. In this case, 1133 returns 1 on success. The predicate can be a lisp function or 1134 an integer to pass to `access' (in which case file-name-handlers 1135 are ignored). 1136 1137 If STOREPTR is nonzero, it points to a slot where the name of 1138 the file actually found should be stored as a Lisp string. 1139 nil is stored there on failure. 1140 1141 If the file we find is remote, return -2 1142 but store the found remote file name in *STOREPTR. */ 1143 1144int 1145openp (path, str, suffixes, storeptr, predicate) 1146 Lisp_Object path, str; 1147 Lisp_Object suffixes; 1148 Lisp_Object *storeptr; 1149 Lisp_Object predicate; 1150{ 1151 register int fd; 1152 int fn_size = 100; 1153 char buf[100]; 1154 register char *fn = buf; 1155 int absolute = 0; 1156 int want_size; 1157 Lisp_Object filename; 1158 struct stat st; 1159 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; 1160 Lisp_Object string, tail, encoded_fn; 1161 int max_suffix_len = 0; 1162 1163 CHECK_STRING (str); 1164 1165 for (tail = suffixes; CONSP (tail); tail = XCDR (tail)) 1166 { 1167 CHECK_STRING_CAR (tail); 1168 max_suffix_len = max (max_suffix_len, 1169 SBYTES (XCAR (tail))); 1170 } 1171 1172 string = filename = encoded_fn = Qnil; 1173 GCPRO6 (str, string, filename, path, suffixes, encoded_fn); 1174 1175 if (storeptr) 1176 *storeptr = Qnil; 1177 1178 if (complete_filename_p (str)) 1179 absolute = 1; 1180 1181 for (; CONSP (path); path = XCDR (path)) 1182 { 1183 filename = Fexpand_file_name (str, XCAR (path)); 1184 if (!complete_filename_p (filename)) 1185 /* If there are non-absolute elts in PATH (eg ".") */ 1186 /* Of course, this could conceivably lose if luser sets 1187 default-directory to be something non-absolute... */ 1188 { 1189 filename = Fexpand_file_name (filename, current_buffer->directory); 1190 if (!complete_filename_p (filename)) 1191 /* Give up on this path element! */ 1192 continue; 1193 } 1194 1195 /* Calculate maximum size of any filename made from 1196 this path element/specified file name and any possible suffix. */ 1197 want_size = max_suffix_len + SBYTES (filename) + 1; 1198 if (fn_size < want_size) 1199 fn = (char *) alloca (fn_size = 100 + want_size); 1200 1201 /* Loop over suffixes. */ 1202 for (tail = NILP (suffixes) ? Fcons (build_string (""), Qnil) : suffixes; 1203 CONSP (tail); tail = XCDR (tail)) 1204 { 1205 int lsuffix = SBYTES (XCAR (tail)); 1206 Lisp_Object handler; 1207 int exists; 1208 1209 /* Concatenate path element/specified name with the suffix. 1210 If the directory starts with /:, remove that. */ 1211 if (SCHARS (filename) > 2 1212 && SREF (filename, 0) == '/' 1213 && SREF (filename, 1) == ':') 1214 { 1215 strncpy (fn, SDATA (filename) + 2, 1216 SBYTES (filename) - 2); 1217 fn[SBYTES (filename) - 2] = 0; 1218 } 1219 else 1220 { 1221 strncpy (fn, SDATA (filename), 1222 SBYTES (filename)); 1223 fn[SBYTES (filename)] = 0; 1224 } 1225 1226 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ 1227 strlcat (fn, SDATA (XCAR (tail)), fn_size); 1228 1229 /* Check that the file exists and is not a directory. */ 1230 /* We used to only check for handlers on non-absolute file names: 1231 if (absolute) 1232 handler = Qnil; 1233 else 1234 handler = Ffind_file_name_handler (filename, Qfile_exists_p); 1235 It's not clear why that was the case and it breaks things like 1236 (load "/bar.el") where the file is actually "/bar.el.gz". */ 1237 string = build_string (fn); 1238 handler = Ffind_file_name_handler (string, Qfile_exists_p); 1239 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) 1240 { 1241 if (NILP (predicate)) 1242 exists = !NILP (Ffile_readable_p (string)); 1243 else 1244 exists = !NILP (call1 (predicate, string)); 1245 if (exists && !NILP (Ffile_directory_p (string))) 1246 exists = 0; 1247 1248 if (exists) 1249 { 1250 /* We succeeded; return this descriptor and filename. */ 1251 if (storeptr) 1252 *storeptr = string; 1253 UNGCPRO; 1254 return -2; 1255 } 1256 } 1257 else 1258 { 1259 const char *pfn; 1260 1261 encoded_fn = ENCODE_FILE (string); 1262 pfn = SDATA (encoded_fn); 1263 exists = (stat (pfn, &st) >= 0 1264 && (st.st_mode & S_IFMT) != S_IFDIR); 1265 if (exists) 1266 { 1267 /* Check that we can access or open it. */ 1268 if (NATNUMP (predicate)) 1269 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1; 1270 else 1271 fd = emacs_open (pfn, O_RDONLY, 0); 1272 1273 if (fd >= 0) 1274 { 1275 /* We succeeded; return this descriptor and filename. */ 1276 if (storeptr) 1277 *storeptr = string; 1278 UNGCPRO; 1279 return fd; 1280 } 1281 } 1282 } 1283 } 1284 if (absolute) 1285 break; 1286 } 1287 1288 UNGCPRO; 1289 return -1; 1290} 1291 1292 1293/* Merge the list we've accumulated of globals from the current input source 1294 into the load_history variable. The details depend on whether 1295 the source has an associated file name or not. 1296 1297 FILENAME is the file name that we are loading from. 1298 ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */ 1299 1300static void 1301build_load_history (filename, entire) 1302 Lisp_Object filename; 1303 int entire; 1304{ 1305 register Lisp_Object tail, prev, newelt; 1306 register Lisp_Object tem, tem2; 1307 register int foundit = 0; 1308 1309 tail = Vload_history; 1310 prev = Qnil; 1311 1312 while (CONSP (tail)) 1313 { 1314 tem = XCAR (tail); 1315 1316 /* Find the feature's previous assoc list... */ 1317 if (!NILP (Fequal (filename, Fcar (tem)))) 1318 { 1319 foundit = 1; 1320 1321 /* If we're loading the entire file, remove old data. */ 1322 if (entire) 1323 { 1324 if (NILP (prev)) 1325 Vload_history = XCDR (tail); 1326 else 1327 Fsetcdr (prev, XCDR (tail)); 1328 } 1329 1330 /* Otherwise, cons on new symbols that are not already members. */ 1331 else 1332 { 1333 tem2 = Vcurrent_load_list; 1334 1335 while (CONSP (tem2)) 1336 { 1337 newelt = XCAR (tem2); 1338 1339 if (NILP (Fmember (newelt, tem))) 1340 Fsetcar (tail, Fcons (XCAR (tem), 1341 Fcons (newelt, XCDR (tem)))); 1342 1343 tem2 = XCDR (tem2); 1344 QUIT; 1345 } 1346 } 1347 } 1348 else 1349 prev = tail; 1350 tail = XCDR (tail); 1351 QUIT; 1352 } 1353 1354 /* If we're loading an entire file, cons the new assoc onto the 1355 front of load-history, the most-recently-loaded position. Also 1356 do this if we didn't find an existing member for the file. */ 1357 if (entire || !foundit) 1358 Vload_history = Fcons (Fnreverse (Vcurrent_load_list), 1359 Vload_history); 1360} 1361 1362Lisp_Object 1363unreadpure (junk) /* Used as unwind-protect function in readevalloop */ 1364 Lisp_Object junk; 1365{ 1366 read_pure = 0; 1367 return Qnil; 1368} 1369 1370static Lisp_Object 1371readevalloop_1 (old) 1372 Lisp_Object old; 1373{ 1374 load_convert_to_unibyte = ! NILP (old); 1375 return Qnil; 1376} 1377 1378/* Signal an `end-of-file' error, if possible with file name 1379 information. */ 1380 1381static void 1382end_of_file_error () 1383{ 1384 Lisp_Object data; 1385 1386 if (STRINGP (Vload_file_name)) 1387 xsignal1 (Qend_of_file, Vload_file_name); 1388 1389 xsignal0 (Qend_of_file); 1390} 1391 1392/* UNIBYTE specifies how to set load_convert_to_unibyte 1393 for this invocation. 1394 READFUN, if non-nil, is used instead of `read'. 1395 1396 START, END specify region to read in current buffer (from eval-region). 1397 If the input is not from a buffer, they must be nil. */ 1398 1399static void 1400readevalloop (readcharfun, stream, sourcename, evalfun, 1401 printflag, unibyte, readfun, start, end) 1402 Lisp_Object readcharfun; 1403 FILE *stream; 1404 Lisp_Object sourcename; 1405 Lisp_Object (*evalfun) (); 1406 int printflag; 1407 Lisp_Object unibyte, readfun; 1408 Lisp_Object start, end; 1409{ 1410 register int c; 1411 register Lisp_Object val; 1412 int count = SPECPDL_INDEX (); 1413 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 1414 struct buffer *b = 0; 1415 int continue_reading_p; 1416 /* Nonzero if reading an entire buffer. */ 1417 int whole_buffer = 0; 1418 /* 1 on the first time around. */ 1419 int first_sexp = 1; 1420 1421 if (MARKERP (readcharfun)) 1422 { 1423 if (NILP (start)) 1424 start = readcharfun; 1425 } 1426 1427 if (BUFFERP (readcharfun)) 1428 b = XBUFFER (readcharfun); 1429 else if (MARKERP (readcharfun)) 1430 b = XMARKER (readcharfun)->buffer; 1431 1432 /* We assume START is nil when input is not from a buffer. */ 1433 if (! NILP (start) && !b) 1434 abort (); 1435 1436 specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */ 1437 specbind (Qcurrent_load_list, Qnil); 1438 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); 1439 load_convert_to_unibyte = !NILP (unibyte); 1440 1441 readchar_backlog = -1; 1442 1443 GCPRO4 (sourcename, readfun, start, end); 1444 1445 /* Try to ensure sourcename is a truename, except whilst preloading. */ 1446 if (NILP (Vpurify_flag) 1447 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)) 1448 && !NILP (Ffboundp (Qfile_truename))) 1449 sourcename = call1 (Qfile_truename, sourcename) ; 1450 1451 LOADHIST_ATTACH (sourcename); 1452 1453 continue_reading_p = 1; 1454 while (continue_reading_p) 1455 { 1456 int count1 = SPECPDL_INDEX (); 1457 1458 if (b != 0 && NILP (b->name)) 1459 error ("Reading from killed buffer"); 1460 1461 if (!NILP (start)) 1462 { 1463 /* Switch to the buffer we are reading from. */ 1464 record_unwind_protect (save_excursion_restore, save_excursion_save ()); 1465 set_buffer_internal (b); 1466 1467 /* Save point in it. */ 1468 record_unwind_protect (save_excursion_restore, save_excursion_save ()); 1469 /* Save ZV in it. */ 1470 record_unwind_protect (save_restriction_restore, save_restriction_save ()); 1471 /* Those get unbound after we read one expression. */ 1472 1473 /* Set point and ZV around stuff to be read. */ 1474 Fgoto_char (start); 1475 if (!NILP (end)) 1476 Fnarrow_to_region (make_number (BEGV), end); 1477 1478 /* Just for cleanliness, convert END to a marker 1479 if it is an integer. */ 1480 if (INTEGERP (end)) 1481 end = Fpoint_max_marker (); 1482 } 1483 1484 /* On the first cycle, we can easily test here 1485 whether we are reading the whole buffer. */ 1486 if (b && first_sexp) 1487 whole_buffer = (PT == BEG && ZV == Z); 1488 1489 instream = stream; 1490 read_next: 1491 c = READCHAR; 1492 if (c == ';') 1493 { 1494 while ((c = READCHAR) != '\n' && c != -1); 1495 goto read_next; 1496 } 1497 if (c < 0) 1498 { 1499 unbind_to (count1, Qnil); 1500 break; 1501 } 1502 1503 /* Ignore whitespace here, so we can detect eof. */ 1504 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r') 1505 goto read_next; 1506 1507 if (!NILP (Vpurify_flag) && c == '(') 1508 { 1509 record_unwind_protect (unreadpure, Qnil); 1510 val = read_list (-1, readcharfun); 1511 } 1512 else 1513 { 1514 UNREAD (c); 1515 read_objects = Qnil; 1516 if (!NILP (readfun)) 1517 { 1518 val = call1 (readfun, readcharfun); 1519 1520 /* If READCHARFUN has set point to ZV, we should 1521 stop reading, even if the form read sets point 1522 to a different value when evaluated. */ 1523 if (BUFFERP (readcharfun)) 1524 { 1525 struct buffer *b = XBUFFER (readcharfun); 1526 if (BUF_PT (b) == BUF_ZV (b)) 1527 continue_reading_p = 0; 1528 } 1529 } 1530 else if (! NILP (Vload_read_function)) 1531 val = call1 (Vload_read_function, readcharfun); 1532 else 1533 val = read_internal_start (readcharfun, Qnil, Qnil); 1534 } 1535 1536 if (!NILP (start) && continue_reading_p) 1537 start = Fpoint_marker (); 1538 1539 /* Restore saved point and BEGV. */ 1540 unbind_to (count1, Qnil); 1541 1542 /* Now eval what we just read. */ 1543 val = (*evalfun) (val); 1544 1545 if (printflag) 1546 { 1547 Vvalues = Fcons (val, Vvalues); 1548 if (EQ (Vstandard_output, Qt)) 1549 Fprin1 (val, Qnil); 1550 else 1551 Fprint (val, Qnil); 1552 } 1553 1554 first_sexp = 0; 1555 } 1556 1557 build_load_history (sourcename, 1558 stream || whole_buffer); 1559 1560 UNGCPRO; 1561 1562 unbind_to (count, Qnil); 1563} 1564 1565DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "", 1566 doc: /* Execute the current buffer as Lisp code. 1567Programs can pass two arguments, BUFFER and PRINTFLAG. 1568BUFFER is the buffer to evaluate (nil means use current buffer). 1569PRINTFLAG controls printing of output: 1570A value of nil means discard it; anything else is stream for print. 1571 1572If the optional third argument FILENAME is non-nil, 1573it specifies the file name to use for `load-history'. 1574The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte' 1575for this invocation. 1576 1577The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that 1578`print' and related functions should work normally even if PRINTFLAG is nil. 1579 1580This function preserves the position of point. */) 1581 (buffer, printflag, filename, unibyte, do_allow_print) 1582 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print; 1583{ 1584 int count = SPECPDL_INDEX (); 1585 Lisp_Object tem, buf; 1586 1587 if (NILP (buffer)) 1588 buf = Fcurrent_buffer (); 1589 else 1590 buf = Fget_buffer (buffer); 1591 if (NILP (buf)) 1592 error ("No such buffer"); 1593 1594 if (NILP (printflag) && NILP (do_allow_print)) 1595 tem = Qsymbolp; 1596 else 1597 tem = printflag; 1598 1599 if (NILP (filename)) 1600 filename = XBUFFER (buf)->filename; 1601 1602 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); 1603 specbind (Qstandard_output, tem); 1604 record_unwind_protect (save_excursion_restore, save_excursion_save ()); 1605 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); 1606 readevalloop (buf, 0, filename, Feval, 1607 !NILP (printflag), unibyte, Qnil, Qnil, Qnil); 1608 unbind_to (count, Qnil); 1609 1610 return Qnil; 1611} 1612 1613DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r", 1614 doc: /* Execute the region as Lisp code. 1615When called from programs, expects two arguments, 1616giving starting and ending indices in the current buffer 1617of the text to be executed. 1618Programs can pass third argument PRINTFLAG which controls output: 1619A value of nil means discard it; anything else is stream for printing it. 1620Also the fourth argument READ-FUNCTION, if non-nil, is used 1621instead of `read' to read each expression. It gets one argument 1622which is the input stream for reading characters. 1623 1624This function does not move point. */) 1625 (start, end, printflag, read_function) 1626 Lisp_Object start, end, printflag, read_function; 1627{ 1628 int count = SPECPDL_INDEX (); 1629 Lisp_Object tem, cbuf; 1630 1631 cbuf = Fcurrent_buffer (); 1632 1633 if (NILP (printflag)) 1634 tem = Qsymbolp; 1635 else 1636 tem = printflag; 1637 specbind (Qstandard_output, tem); 1638 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); 1639 1640 /* readevalloop calls functions which check the type of start and end. */ 1641 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, 1642 !NILP (printflag), Qnil, read_function, 1643 start, end); 1644 1645 return unbind_to (count, Qnil); 1646} 1647 1648 1649DEFUN ("read", Fread, Sread, 0, 1, 0, 1650 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object. 1651If STREAM is nil, use the value of `standard-input' (which see). 1652STREAM or the value of `standard-input' may be: 1653 a buffer (read from point and advance it) 1654 a marker (read from where it points and advance it) 1655 a function (call it with no arguments for each character, 1656 call it with a char as argument to push a char back) 1657 a string (takes text from string, starting at the beginning) 1658 t (read text line using minibuffer and use it, or read from 1659 standard input in batch mode). */) 1660 (stream) 1661 Lisp_Object stream; 1662{ 1663 if (NILP (stream)) 1664 stream = Vstandard_input; 1665 if (EQ (stream, Qt)) 1666 stream = Qread_char; 1667 if (EQ (stream, Qread_char)) 1668 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil); 1669 1670 return read_internal_start (stream, Qnil, Qnil); 1671} 1672 1673DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, 1674 doc: /* Read one Lisp expression which is represented as text by STRING. 1675Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX). 1676START and END optionally delimit a substring of STRING from which to read; 1677 they default to 0 and (length STRING) respectively. */) 1678 (string, start, end) 1679 Lisp_Object string, start, end; 1680{ 1681 Lisp_Object ret; 1682 CHECK_STRING (string); 1683 /* read_internal_start sets read_from_string_index. */ 1684 ret = read_internal_start (string, start, end); 1685 return Fcons (ret, make_number (read_from_string_index)); 1686} 1687 1688/* Function to set up the global context we need in toplevel read 1689 calls. */ 1690static Lisp_Object 1691read_internal_start (stream, start, end) 1692 Lisp_Object stream; 1693 Lisp_Object start; /* Only used when stream is a string. */ 1694 Lisp_Object end; /* Only used when stream is a string. */ 1695{ 1696 Lisp_Object retval; 1697 1698 readchar_backlog = -1; 1699 readchar_count = 0; 1700 new_backquote_flag = 0; 1701 read_objects = Qnil; 1702 if (EQ (Vread_with_symbol_positions, Qt) 1703 || EQ (Vread_with_symbol_positions, stream)) 1704 Vread_symbol_positions_list = Qnil; 1705 1706 if (STRINGP (stream)) 1707 { 1708 int startval, endval; 1709 if (NILP (end)) 1710 endval = SCHARS (stream); 1711 else 1712 { 1713 CHECK_NUMBER (end); 1714 endval = XINT (end); 1715 if (endval < 0 || endval > SCHARS (stream)) 1716 args_out_of_range (stream, end); 1717 } 1718 1719 if (NILP (start)) 1720 startval = 0; 1721 else 1722 { 1723 CHECK_NUMBER (start); 1724 startval = XINT (start); 1725 if (startval < 0 || startval > endval) 1726 args_out_of_range (stream, start); 1727 } 1728 read_from_string_index = startval; 1729 read_from_string_index_byte = string_char_to_byte (stream, startval); 1730 read_from_string_limit = endval; 1731 } 1732 1733 retval = read0 (stream); 1734 if (EQ (Vread_with_symbol_positions, Qt) 1735 || EQ (Vread_with_symbol_positions, stream)) 1736 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list); 1737 return retval; 1738} 1739 1740 1741/* Signal Qinvalid_read_syntax error. 1742 S is error string of length N (if > 0) */ 1743 1744static void 1745invalid_syntax (s, n) 1746 const char *s; 1747 int n; 1748{ 1749 if (!n) 1750 n = strlen (s); 1751 xsignal1 (Qinvalid_read_syntax, make_string (s, n)); 1752} 1753 1754 1755/* Use this for recursive reads, in contexts where internal tokens 1756 are not allowed. */ 1757 1758static Lisp_Object 1759read0 (readcharfun) 1760 Lisp_Object readcharfun; 1761{ 1762 register Lisp_Object val; 1763 int c; 1764 1765 val = read1 (readcharfun, &c, 0); 1766 if (!c) 1767 return val; 1768 1769 xsignal1 (Qinvalid_read_syntax, 1770 Fmake_string (make_number (1), make_number (c))); 1771} 1772 1773static int read_buffer_size; 1774static char *read_buffer; 1775 1776/* Read multibyte form and return it as a character. C is a first 1777 byte of multibyte form, and rest of them are read from 1778 READCHARFUN. */ 1779 1780static int 1781read_multibyte (c, readcharfun) 1782 register int c; 1783 Lisp_Object readcharfun; 1784{ 1785 /* We need the actual character code of this multibyte 1786 characters. */ 1787 unsigned char str[MAX_MULTIBYTE_LENGTH]; 1788 int len = 0; 1789 int bytes; 1790 1791 if (c < 0) 1792 return c; 1793 1794 str[len++] = c; 1795 while ((c = READCHAR) >= 0xA0 1796 && len < MAX_MULTIBYTE_LENGTH) 1797 { 1798 str[len++] = c; 1799 readchar_count--; 1800 } 1801 UNREAD (c); 1802 if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes)) 1803 return STRING_CHAR (str, len); 1804 /* The byte sequence is not valid as multibyte. Unread all bytes 1805 but the first one, and return the first byte. */ 1806 while (--len > 0) 1807 UNREAD (str[len]); 1808 return str[0]; 1809} 1810 1811/* Read a \-escape sequence, assuming we already read the `\'. 1812 If the escape sequence forces unibyte, store 1 into *BYTEREP. 1813 If the escape sequence forces multibyte, store 2 into *BYTEREP. 1814 Otherwise store 0 into *BYTEREP. */ 1815 1816static int 1817read_escape (readcharfun, stringp, byterep) 1818 Lisp_Object readcharfun; 1819 int stringp; 1820 int *byterep; 1821{ 1822 register int c = READCHAR; 1823 /* \u allows up to four hex digits, \U up to eight. Default to the 1824 behaviour for \u, and change this value in the case that \U is seen. */ 1825 int unicode_hex_count = 4; 1826 1827 *byterep = 0; 1828 1829 switch (c) 1830 { 1831 case -1: 1832 end_of_file_error (); 1833 1834 case 'a': 1835 return '\007'; 1836 case 'b': 1837 return '\b'; 1838 case 'd': 1839 return 0177; 1840 case 'e': 1841 return 033; 1842 case 'f': 1843 return '\f'; 1844 case 'n': 1845 return '\n'; 1846 case 'r': 1847 return '\r'; 1848 case 't': 1849 return '\t'; 1850 case 'v': 1851 return '\v'; 1852 case '\n': 1853 return -1; 1854 case ' ': 1855 if (stringp) 1856 return -1; 1857 return ' '; 1858 1859 case 'M': 1860 c = READCHAR; 1861 if (c != '-') 1862 error ("Invalid escape character syntax"); 1863 c = READCHAR; 1864 if (c == '\\') 1865 c = read_escape (readcharfun, 0, byterep); 1866 return c | meta_modifier; 1867 1868 case 'S': 1869 c = READCHAR; 1870 if (c != '-') 1871 error ("Invalid escape character syntax"); 1872 c = READCHAR; 1873 if (c == '\\') 1874 c = read_escape (readcharfun, 0, byterep); 1875 return c | shift_modifier; 1876 1877 case 'H': 1878 c = READCHAR; 1879 if (c != '-') 1880 error ("Invalid escape character syntax"); 1881 c = READCHAR; 1882 if (c == '\\') 1883 c = read_escape (readcharfun, 0, byterep); 1884 return c | hyper_modifier; 1885 1886 case 'A': 1887 c = READCHAR; 1888 if (c != '-') 1889 error ("Invalid escape character syntax"); 1890 c = READCHAR; 1891 if (c == '\\') 1892 c = read_escape (readcharfun, 0, byterep); 1893 return c | alt_modifier; 1894 1895 case 's': 1896 c = READCHAR; 1897 if (c != '-') 1898 { 1899 UNREAD (c); 1900 return ' '; 1901 } 1902 c = READCHAR; 1903 if (c == '\\') 1904 c = read_escape (readcharfun, 0, byterep); 1905 return c | super_modifier; 1906 1907 case 'C': 1908 c = READCHAR; 1909 if (c != '-') 1910 error ("Invalid escape character syntax"); 1911 case '^': 1912 c = READCHAR; 1913 if (c == '\\') 1914 c = read_escape (readcharfun, 0, byterep); 1915 if ((c & ~CHAR_MODIFIER_MASK) == '?') 1916 return 0177 | (c & CHAR_MODIFIER_MASK); 1917 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) 1918 return c | ctrl_modifier; 1919 /* ASCII control chars are made from letters (both cases), 1920 as well as the non-letters within 0100...0137. */ 1921 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) 1922 return (c & (037 | ~0177)); 1923 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) 1924 return (c & (037 | ~0177)); 1925 else 1926 return c | ctrl_modifier; 1927 1928 case '0': 1929 case '1': 1930 case '2': 1931 case '3': 1932 case '4': 1933 case '5': 1934 case '6': 1935 case '7': 1936 /* An octal escape, as in ANSI C. */ 1937 { 1938 register int i = c - '0'; 1939 register int count = 0; 1940 while (++count < 3) 1941 { 1942 if ((c = READCHAR) >= '0' && c <= '7') 1943 { 1944 i *= 8; 1945 i += c - '0'; 1946 } 1947 else 1948 { 1949 UNREAD (c); 1950 break; 1951 } 1952 } 1953 1954 *byterep = 1; 1955 return i; 1956 } 1957 1958 case 'x': 1959 /* A hex escape, as in ANSI C. */ 1960 { 1961 int i = 0; 1962 while (1) 1963 { 1964 c = READCHAR; 1965 if (c >= '0' && c <= '9') 1966 { 1967 i *= 16; 1968 i += c - '0'; 1969 } 1970 else if ((c >= 'a' && c <= 'f') 1971 || (c >= 'A' && c <= 'F')) 1972 { 1973 i *= 16; 1974 if (c >= 'a' && c <= 'f') 1975 i += c - 'a' + 10; 1976 else 1977 i += c - 'A' + 10; 1978 } 1979 else 1980 { 1981 UNREAD (c); 1982 break; 1983 } 1984 } 1985 1986 *byterep = 2; 1987 return i; 1988 } 1989 1990 case 'U': 1991 /* Post-Unicode-2.0: Up to eight hex chars. */ 1992 unicode_hex_count = 8; 1993 case 'u': 1994 1995 /* A Unicode escape. We only permit them in strings and characters, 1996 not arbitrarily in the source code, as in some other languages. */ 1997 { 1998 int i = 0; 1999 int count = 0; 2000 Lisp_Object lisp_char; 2001 struct gcpro gcpro1; 2002 2003 while (++count <= unicode_hex_count) 2004 { 2005 c = READCHAR; 2006 /* isdigit and isalpha may be locale-specific, which we don't 2007 want. */ 2008 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); 2009 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; 2010 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; 2011 else 2012 { 2013 error ("Non-hex digit used for Unicode escape"); 2014 break; 2015 } 2016 } 2017 2018 GCPRO1 (readcharfun); 2019 lisp_char = call2 (intern ("decode-char"), intern ("ucs"), 2020 make_number (i)); 2021 UNGCPRO; 2022 2023 if (NILP (lisp_char)) 2024 { 2025 error ("Unsupported Unicode code point: U+%x", (unsigned)i); 2026 } 2027 2028 return XFASTINT (lisp_char); 2029 } 2030 2031 default: 2032 if (BASE_LEADING_CODE_P (c)) 2033 c = read_multibyte (c, readcharfun); 2034 return c; 2035 } 2036} 2037 2038/* Read an integer in radix RADIX using READCHARFUN to read 2039 characters. RADIX must be in the interval [2..36]; if it isn't, a 2040 read error is signaled . Value is the integer read. Signals an 2041 error if encountering invalid read syntax or if RADIX is out of 2042 range. */ 2043 2044static Lisp_Object 2045read_integer (readcharfun, radix) 2046 Lisp_Object readcharfun; 2047 int radix; 2048{ 2049 int ndigits = 0, invalid_p, c, sign = 0; 2050 EMACS_INT number = 0; 2051 2052 if (radix < 2 || radix > 36) 2053 invalid_p = 1; 2054 else 2055 { 2056 number = ndigits = invalid_p = 0; 2057 sign = 1; 2058 2059 c = READCHAR; 2060 if (c == '-') 2061 { 2062 c = READCHAR; 2063 sign = -1; 2064 } 2065 else if (c == '+') 2066 c = READCHAR; 2067 2068 while (c >= 0) 2069 { 2070 int digit; 2071 2072 if (c >= '0' && c <= '9') 2073 digit = c - '0'; 2074 else if (c >= 'a' && c <= 'z') 2075 digit = c - 'a' + 10; 2076 else if (c >= 'A' && c <= 'Z') 2077 digit = c - 'A' + 10; 2078 else 2079 { 2080 UNREAD (c); 2081 break; 2082 } 2083 2084 if (digit < 0 || digit >= radix) 2085 invalid_p = 1; 2086 2087 number = radix * number + digit; 2088 ++ndigits; 2089 c = READCHAR; 2090 } 2091 } 2092 2093 if (ndigits == 0 || invalid_p) 2094 { 2095 char buf[50]; 2096 sprintf (buf, "integer, radix %d", radix); 2097 invalid_syntax (buf, 0); 2098 } 2099 2100 return make_number (sign * number); 2101} 2102 2103 2104/* Convert unibyte text in read_buffer to multibyte. 2105 2106 Initially, *P is a pointer after the end of the unibyte text, and 2107 the pointer *END points after the end of read_buffer. 2108 2109 If read_buffer doesn't have enough room to hold the result 2110 of the conversion, reallocate it and adjust *P and *END. 2111 2112 At the end, make *P point after the result of the conversion, and 2113 return in *NCHARS the number of characters in the converted 2114 text. */ 2115 2116static void 2117to_multibyte (p, end, nchars) 2118 char **p, **end; 2119 int *nchars; 2120{ 2121 int nbytes; 2122 2123 parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars); 2124 if (read_buffer_size < 2 * nbytes) 2125 { 2126 int offset = *p - read_buffer; 2127 read_buffer_size = 2 * max (read_buffer_size, nbytes); 2128 read_buffer = (char *) xrealloc (read_buffer, read_buffer_size); 2129 *p = read_buffer + offset; 2130 *end = read_buffer + read_buffer_size; 2131 } 2132 2133 if (nbytes != *nchars) 2134 nbytes = str_as_multibyte (read_buffer, read_buffer_size, 2135 *p - read_buffer, nchars); 2136 2137 *p = read_buffer + nbytes; 2138} 2139 2140 2141/* If the next token is ')' or ']' or '.', we store that character 2142 in *PCH and the return value is not interesting. Else, we store 2143 zero in *PCH and we read and return one lisp object. 2144 2145 FIRST_IN_LIST is nonzero if this is the first element of a list. */ 2146 2147static Lisp_Object 2148read1 (readcharfun, pch, first_in_list) 2149 register Lisp_Object readcharfun; 2150 int *pch; 2151 int first_in_list; 2152{ 2153 register int c; 2154 int uninterned_symbol = 0; 2155 2156 *pch = 0; 2157 2158 retry: 2159 2160 c = READCHAR; 2161 if (c < 0) 2162 end_of_file_error (); 2163 2164 switch (c) 2165 { 2166 case '(': 2167 return read_list (0, readcharfun); 2168 2169 case '[': 2170 return read_vector (readcharfun, 0); 2171 2172 case ')': 2173 case ']': 2174 { 2175 *pch = c; 2176 return Qnil; 2177 } 2178 2179 case '#': 2180 c = READCHAR; 2181 if (c == '^') 2182 { 2183 c = READCHAR; 2184 if (c == '[') 2185 { 2186 Lisp_Object tmp; 2187 tmp = read_vector (readcharfun, 0); 2188 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS 2189 || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10) 2190 error ("Invalid size char-table"); 2191 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp)); 2192 XCHAR_TABLE (tmp)->top = Qt; 2193 return tmp; 2194 } 2195 else if (c == '^') 2196 { 2197 c = READCHAR; 2198 if (c == '[') 2199 { 2200 Lisp_Object tmp; 2201 tmp = read_vector (readcharfun, 0); 2202 if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS) 2203 error ("Invalid size char-table"); 2204 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp)); 2205 XCHAR_TABLE (tmp)->top = Qnil; 2206 return tmp; 2207 } 2208 invalid_syntax ("#^^", 3); 2209 } 2210 invalid_syntax ("#^", 2); 2211 } 2212 if (c == '&') 2213 { 2214 Lisp_Object length; 2215 length = read1 (readcharfun, pch, first_in_list); 2216 c = READCHAR; 2217 if (c == '"') 2218 { 2219 Lisp_Object tmp, val; 2220 int size_in_chars 2221 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) 2222 / BOOL_VECTOR_BITS_PER_CHAR); 2223 2224 UNREAD (c); 2225 tmp = read1 (readcharfun, pch, first_in_list); 2226 if (size_in_chars != SCHARS (tmp) 2227 /* We used to print 1 char too many 2228 when the number of bits was a multiple of 8. 2229 Accept such input in case it came from an old version. */ 2230 && ! (XFASTINT (length) 2231 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) 2232 invalid_syntax ("#&...", 5); 2233 2234 val = Fmake_bool_vector (length, Qnil); 2235 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, 2236 size_in_chars); 2237 /* Clear the extraneous bits in the last byte. */ 2238 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) 2239 XBOOL_VECTOR (val)->data[size_in_chars - 1] 2240 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; 2241 return val; 2242 } 2243 invalid_syntax ("#&...", 5); 2244 } 2245 if (c == '[') 2246 { 2247 /* Accept compiled functions at read-time so that we don't have to 2248 build them using function calls. */ 2249 Lisp_Object tmp; 2250 tmp = read_vector (readcharfun, 1); 2251 return Fmake_byte_code (XVECTOR (tmp)->size, 2252 XVECTOR (tmp)->contents); 2253 } 2254 if (c == '(') 2255 { 2256 Lisp_Object tmp; 2257 struct gcpro gcpro1; 2258 int ch; 2259 2260 /* Read the string itself. */ 2261 tmp = read1 (readcharfun, &ch, 0); 2262 if (ch != 0 || !STRINGP (tmp)) 2263 invalid_syntax ("#", 1); 2264 GCPRO1 (tmp); 2265 /* Read the intervals and their properties. */ 2266 while (1) 2267 { 2268 Lisp_Object beg, end, plist; 2269 2270 beg = read1 (readcharfun, &ch, 0); 2271 end = plist = Qnil; 2272 if (ch == ')') 2273 break; 2274 if (ch == 0) 2275 end = read1 (readcharfun, &ch, 0); 2276 if (ch == 0) 2277 plist = read1 (readcharfun, &ch, 0); 2278 if (ch) 2279 invalid_syntax ("Invalid string property list", 0); 2280 Fset_text_properties (beg, end, plist, tmp); 2281 } 2282 UNGCPRO; 2283 return tmp; 2284 } 2285 2286 /* #@NUMBER is used to skip NUMBER following characters. 2287 That's used in .elc files to skip over doc strings 2288 and function definitions. */ 2289 if (c == '@') 2290 { 2291 int i, nskip = 0; 2292 2293 /* Read a decimal integer. */ 2294 while ((c = READCHAR) >= 0 2295 && c >= '0' && c <= '9') 2296 { 2297 nskip *= 10; 2298 nskip += c - '0'; 2299 } 2300 if (c >= 0) 2301 UNREAD (c); 2302 2303 if (load_force_doc_strings && EQ (readcharfun, Qget_file_char)) 2304 { 2305 /* If we are supposed to force doc strings into core right now, 2306 record the last string that we skipped, 2307 and record where in the file it comes from. */ 2308 2309 /* But first exchange saved_doc_string 2310 with prev_saved_doc_string, so we save two strings. */ 2311 { 2312 char *temp = saved_doc_string; 2313 int temp_size = saved_doc_string_size; 2314 file_offset temp_pos = saved_doc_string_position; 2315 int temp_len = saved_doc_string_length; 2316 2317 saved_doc_string = prev_saved_doc_string; 2318 saved_doc_string_size = prev_saved_doc_string_size; 2319 saved_doc_string_position = prev_saved_doc_string_position; 2320 saved_doc_string_length = prev_saved_doc_string_length; 2321 2322 prev_saved_doc_string = temp; 2323 prev_saved_doc_string_size = temp_size; 2324 prev_saved_doc_string_position = temp_pos; 2325 prev_saved_doc_string_length = temp_len; 2326 } 2327 2328 if (saved_doc_string_size == 0) 2329 { 2330 saved_doc_string_size = nskip + 100; 2331 saved_doc_string = (char *) xmalloc (saved_doc_string_size); 2332 } 2333 if (nskip > saved_doc_string_size) 2334 { 2335 saved_doc_string_size = nskip + 100; 2336 saved_doc_string = (char *) xrealloc (saved_doc_string, 2337 saved_doc_string_size); 2338 } 2339 2340 saved_doc_string_position = file_tell (instream); 2341 2342 /* Copy that many characters into saved_doc_string. */ 2343 for (i = 0; i < nskip && c >= 0; i++) 2344 saved_doc_string[i] = c = READCHAR; 2345 2346 saved_doc_string_length = i; 2347 } 2348 else 2349 { 2350 /* Skip that many characters. */ 2351 for (i = 0; i < nskip && c >= 0; i++) 2352 c = READCHAR; 2353 } 2354 2355 goto retry; 2356 } 2357 if (c == '!') 2358 { 2359 /* #! appears at the beginning of an executable file. 2360 Skip the first line. */ 2361 while (c != '\n' && c >= 0) 2362 c = READCHAR; 2363 goto retry; 2364 } 2365 if (c == '$') 2366 return Vload_file_name; 2367 if (c == '\'') 2368 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil)); 2369 /* #:foo is the uninterned symbol named foo. */ 2370 if (c == ':') 2371 { 2372 uninterned_symbol = 1; 2373 c = READCHAR; 2374 goto default_label; 2375 } 2376 /* Reader forms that can reuse previously read objects. */ 2377 if (c >= '0' && c <= '9') 2378 { 2379 int n = 0; 2380 Lisp_Object tem; 2381 2382 /* Read a non-negative integer. */ 2383 while (c >= '0' && c <= '9') 2384 { 2385 n *= 10; 2386 n += c - '0'; 2387 c = READCHAR; 2388 } 2389 /* #n=object returns object, but associates it with n for #n#. */ 2390 if (c == '=') 2391 { 2392 /* Make a placeholder for #n# to use temporarily */ 2393 Lisp_Object placeholder; 2394 Lisp_Object cell; 2395 2396 placeholder = Fcons(Qnil, Qnil); 2397 cell = Fcons (make_number (n), placeholder); 2398 read_objects = Fcons (cell, read_objects); 2399 2400 /* Read the object itself. */ 2401 tem = read0 (readcharfun); 2402 2403 /* Now put it everywhere the placeholder was... */ 2404 substitute_object_in_subtree (tem, placeholder); 2405 2406 /* ...and #n# will use the real value from now on. */ 2407 Fsetcdr (cell, tem); 2408 2409 return tem; 2410 } 2411 /* #n# returns a previously read object. */ 2412 if (c == '#') 2413 { 2414 tem = Fassq (make_number (n), read_objects); 2415 if (CONSP (tem)) 2416 return XCDR (tem); 2417 /* Fall through to error message. */ 2418 } 2419 else if (c == 'r' || c == 'R') 2420 return read_integer (readcharfun, n); 2421 2422 /* Fall through to error message. */ 2423 } 2424 else if (c == 'x' || c == 'X') 2425 return read_integer (readcharfun, 16); 2426 else if (c == 'o' || c == 'O') 2427 return read_integer (readcharfun, 8); 2428 else if (c == 'b' || c == 'B') 2429 return read_integer (readcharfun, 2); 2430 2431 UNREAD (c); 2432 invalid_syntax ("#", 1); 2433 2434 case ';': 2435 while ((c = READCHAR) >= 0 && c != '\n'); 2436 goto retry; 2437 2438 case '\'': 2439 { 2440 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil)); 2441 } 2442 2443 case '`': 2444 if (first_in_list) 2445 goto default_label; 2446 else 2447 { 2448 Lisp_Object value; 2449 2450 new_backquote_flag++; 2451 value = read0 (readcharfun); 2452 new_backquote_flag--; 2453 2454 return Fcons (Qbackquote, Fcons (value, Qnil)); 2455 } 2456 2457 case ',': 2458 if (new_backquote_flag) 2459 { 2460 Lisp_Object comma_type = Qnil; 2461 Lisp_Object value; 2462 int ch = READCHAR; 2463 2464 if (ch == '@') 2465 comma_type = Qcomma_at; 2466 else if (ch == '.') 2467 comma_type = Qcomma_dot; 2468 else 2469 { 2470 if (ch >= 0) UNREAD (ch); 2471 comma_type = Qcomma; 2472 } 2473 2474 new_backquote_flag--; 2475 value = read0 (readcharfun); 2476 new_backquote_flag++; 2477 return Fcons (comma_type, Fcons (value, Qnil)); 2478 } 2479 else 2480 goto default_label; 2481 2482 case '?': 2483 { 2484 int discard; 2485 int next_char; 2486 int ok; 2487 2488 c = READCHAR; 2489 if (c < 0) 2490 end_of_file_error (); 2491 2492 /* Accept `single space' syntax like (list ? x) where the 2493 whitespace character is SPC or TAB. 2494 Other literal whitespace like NL, CR, and FF are not accepted, 2495 as there are well-established escape sequences for these. */ 2496 if (c == ' ' || c == '\t') 2497 return make_number (c); 2498 2499 if (c == '\\') 2500 c = read_escape (readcharfun, 0, &discard); 2501 else if (BASE_LEADING_CODE_P (c)) 2502 c = read_multibyte (c, readcharfun); 2503 2504 next_char = READCHAR; 2505 if (next_char == '.') 2506 { 2507 /* Only a dotted-pair dot is valid after a char constant. */ 2508 int next_next_char = READCHAR; 2509 UNREAD (next_next_char); 2510 2511 ok = (next_next_char <= 040 2512 || (next_next_char < 0200 2513 && (index ("\"';([#?", next_next_char) 2514 || (!first_in_list && next_next_char == '`') 2515 || (new_backquote_flag && next_next_char == ',')))); 2516 } 2517 else 2518 { 2519 ok = (next_char <= 040 2520 || (next_char < 0200 2521 && (index ("\"';()[]#?", next_char) 2522 || (!first_in_list && next_char == '`') 2523 || (new_backquote_flag && next_char == ',')))); 2524 } 2525 UNREAD (next_char); 2526 if (ok) 2527 return make_number (c); 2528 2529 invalid_syntax ("?", 1); 2530 } 2531 2532 case '"': 2533 { 2534 char *p = read_buffer; 2535 char *end = read_buffer + read_buffer_size; 2536 register int c; 2537 /* 1 if we saw an escape sequence specifying 2538 a multibyte character, or a multibyte character. */ 2539 int force_multibyte = 0; 2540 /* 1 if we saw an escape sequence specifying 2541 a single-byte character. */ 2542 int force_singlebyte = 0; 2543 /* 1 if read_buffer contains multibyte text now. */ 2544 int is_multibyte = 0; 2545 int cancel = 0; 2546 int nchars = 0; 2547 2548 while ((c = READCHAR) >= 0 2549 && c != '\"') 2550 { 2551 if (end - p < MAX_MULTIBYTE_LENGTH) 2552 { 2553 int offset = p - read_buffer; 2554 read_buffer = (char *) xrealloc (read_buffer, 2555 read_buffer_size *= 2); 2556 p = read_buffer + offset; 2557 end = read_buffer + read_buffer_size; 2558 } 2559 2560 if (c == '\\') 2561 { 2562 int byterep; 2563 2564 c = read_escape (readcharfun, 1, &byterep); 2565 2566 /* C is -1 if \ newline has just been seen */ 2567 if (c == -1) 2568 { 2569 if (p == read_buffer) 2570 cancel = 1; 2571 continue; 2572 } 2573 2574 if (byterep == 1) 2575 force_singlebyte = 1; 2576 else if (byterep == 2) 2577 force_multibyte = 1; 2578 } 2579 2580 /* A character that must be multibyte forces multibyte. */ 2581 if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK)) 2582 force_multibyte = 1; 2583 2584 /* If we just discovered the need to be multibyte, 2585 convert the text accumulated thus far. */ 2586 if (force_multibyte && ! is_multibyte) 2587 { 2588 is_multibyte = 1; 2589 to_multibyte (&p, &end, &nchars); 2590 } 2591 2592 /* Allow `\C- ' and `\C-?'. */ 2593 if (c == (CHAR_CTL | ' ')) 2594 c = 0; 2595 else if (c == (CHAR_CTL | '?')) 2596 c = 127; 2597 2598 if (c & CHAR_SHIFT) 2599 { 2600 /* Shift modifier is valid only with [A-Za-z]. */ 2601 if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') 2602 c &= ~CHAR_SHIFT; 2603 else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') 2604 c = (c & ~CHAR_SHIFT) - ('a' - 'A'); 2605 } 2606 2607 if (c & CHAR_META) 2608 /* Move the meta bit to the right place for a string. */ 2609 c = (c & ~CHAR_META) | 0x80; 2610 if (c & CHAR_MODIFIER_MASK) 2611 error ("Invalid modifier in string"); 2612 2613 if (is_multibyte) 2614 p += CHAR_STRING (c, p); 2615 else 2616 *p++ = c; 2617 2618 nchars++; 2619 } 2620 2621 if (c < 0) 2622 end_of_file_error (); 2623 2624 /* If purifying, and string starts with \ newline, 2625 return zero instead. This is for doc strings 2626 that we are really going to find in etc/DOC.nn.nn */ 2627 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) 2628 return make_number (0); 2629 2630 if (is_multibyte || force_singlebyte) 2631 ; 2632 else if (load_convert_to_unibyte) 2633 { 2634 Lisp_Object string; 2635 to_multibyte (&p, &end, &nchars); 2636 if (p - read_buffer != nchars) 2637 { 2638 string = make_multibyte_string (read_buffer, nchars, 2639 p - read_buffer); 2640 return Fstring_make_unibyte (string); 2641 } 2642 /* We can make a unibyte string directly. */ 2643 is_multibyte = 0; 2644 } 2645 else if (EQ (readcharfun, Qget_file_char) 2646 || EQ (readcharfun, Qlambda)) 2647 { 2648 /* Nowadays, reading directly from a file is used only for 2649 compiled Emacs Lisp files, and those always use the 2650 Emacs internal encoding. Meanwhile, Qlambda is used 2651 for reading dynamic byte code (compiled with 2652 byte-compile-dynamic = t). So make the string multibyte 2653 if the string contains any multibyte sequences. 2654 (to_multibyte is a no-op if not.) */ 2655 to_multibyte (&p, &end, &nchars); 2656 is_multibyte = (p - read_buffer) != nchars; 2657 } 2658 else 2659 /* In all other cases, if we read these bytes as 2660 separate characters, treat them as separate characters now. */ 2661 ; 2662 2663 /* We want readchar_count to be the number of characters, not 2664 bytes. Hence we adjust for multibyte characters in the 2665 string. ... But it doesn't seem to be necessary, because 2666 READCHAR *does* read multibyte characters from buffers. */ 2667 /* readchar_count -= (p - read_buffer) - nchars; */ 2668 if (read_pure) 2669 return make_pure_string (read_buffer, nchars, p - read_buffer, 2670 is_multibyte); 2671 return make_specified_string (read_buffer, nchars, p - read_buffer, 2672 is_multibyte); 2673 } 2674 2675 case '.': 2676 { 2677 int next_char = READCHAR; 2678 UNREAD (next_char); 2679 2680 if (next_char <= 040 2681 || (next_char < 0200 2682 && (index ("\"';([#?", next_char) 2683 || (!first_in_list && next_char == '`') 2684 || (new_backquote_flag && next_char == ',')))) 2685 { 2686 *pch = c; 2687 return Qnil; 2688 } 2689 2690 /* Otherwise, we fall through! Note that the atom-reading loop 2691 below will now loop at least once, assuring that we will not 2692 try to UNREAD two characters in a row. */ 2693 } 2694 default: 2695 default_label: 2696 if (c <= 040) goto retry; 2697 { 2698 char *p = read_buffer; 2699 int quoted = 0; 2700 2701 { 2702 char *end = read_buffer + read_buffer_size; 2703 2704 while (c > 040 2705 && (c >= 0200 2706 || (!index ("\"';()[]#", c) 2707 && !(!first_in_list && c == '`') 2708 && !(new_backquote_flag && c == ',')))) 2709 { 2710 if (end - p < MAX_MULTIBYTE_LENGTH) 2711 { 2712 int offset = p - read_buffer; 2713 read_buffer = (char *) xrealloc (read_buffer, 2714 read_buffer_size *= 2); 2715 p = read_buffer + offset; 2716 end = read_buffer + read_buffer_size; 2717 } 2718 2719 if (c == '\\') 2720 { 2721 c = READCHAR; 2722 if (c == -1) 2723 end_of_file_error (); 2724 quoted = 1; 2725 } 2726 2727 if (! SINGLE_BYTE_CHAR_P (c)) 2728 p += CHAR_STRING (c, p); 2729 else 2730 *p++ = c; 2731 2732 c = READCHAR; 2733 } 2734 2735 if (p == end) 2736 { 2737 int offset = p - read_buffer; 2738 read_buffer = (char *) xrealloc (read_buffer, 2739 read_buffer_size *= 2); 2740 p = read_buffer + offset; 2741 end = read_buffer + read_buffer_size; 2742 } 2743 *p = 0; 2744 if (c >= 0) 2745 UNREAD (c); 2746 } 2747 2748 if (!quoted && !uninterned_symbol) 2749 { 2750 register char *p1; 2751 register Lisp_Object val; 2752 p1 = read_buffer; 2753 if (*p1 == '+' || *p1 == '-') p1++; 2754 /* Is it an integer? */ 2755 if (p1 != p) 2756 { 2757 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++; 2758 /* Integers can have trailing decimal points. */ 2759 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++; 2760 if (p1 == p) 2761 /* It is an integer. */ 2762 { 2763 if (p1[-1] == '.') 2764 p1[-1] = '\0'; 2765 if (sizeof (int) == sizeof (EMACS_INT)) 2766 XSETINT (val, atoi (read_buffer)); 2767 else if (sizeof (long) == sizeof (EMACS_INT)) 2768 XSETINT (val, atol (read_buffer)); 2769 else 2770 abort (); 2771 return val; 2772 } 2773 } 2774 if (isfloat_string (read_buffer)) 2775 { 2776 /* Compute NaN and infinities using 0.0 in a variable, 2777 to cope with compilers that think they are smarter 2778 than we are. */ 2779 double zero = 0.0; 2780 2781 double value; 2782 2783 /* Negate the value ourselves. This treats 0, NaNs, 2784 and infinity properly on IEEE floating point hosts, 2785 and works around a common bug where atof ("-0.0") 2786 drops the sign. */ 2787 int negative = read_buffer[0] == '-'; 2788 2789 /* The only way p[-1] can be 'F' or 'N', after isfloat_string 2790 returns 1, is if the input ends in e+INF or e+NaN. */ 2791 switch (p[-1]) 2792 { 2793 case 'F': 2794 value = 1.0 / zero; 2795 break; 2796 case 'N': 2797 value = zero / zero; 2798 2799 /* If that made a "negative" NaN, negate it. */ 2800 2801 { 2802 int i; 2803 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero; 2804 2805 u_data.d = value; 2806 u_minus_zero.d = - 0.0; 2807 for (i = 0; i < sizeof (double); i++) 2808 if (u_data.c[i] & u_minus_zero.c[i]) 2809 { 2810 value = - value; 2811 break; 2812 } 2813 } 2814 /* Now VALUE is a positive NaN. */ 2815 break; 2816 default: 2817 value = atof (read_buffer + negative); 2818 break; 2819 } 2820 2821 return make_float (negative ? - value : value); 2822 } 2823 } 2824 { 2825 Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer) 2826 : intern (read_buffer); 2827 if (EQ (Vread_with_symbol_positions, Qt) 2828 || EQ (Vread_with_symbol_positions, readcharfun)) 2829 Vread_symbol_positions_list = 2830 /* Kind of a hack; this will probably fail if characters 2831 in the symbol name were escaped. Not really a big 2832 deal, though. */ 2833 Fcons (Fcons (result, 2834 make_number (readchar_count 2835 - XFASTINT (Flength (Fsymbol_name (result))))), 2836 Vread_symbol_positions_list); 2837 return result; 2838 } 2839 } 2840 } 2841} 2842 2843 2844/* List of nodes we've seen during substitute_object_in_subtree. */ 2845static Lisp_Object seen_list; 2846 2847static void 2848substitute_object_in_subtree (object, placeholder) 2849 Lisp_Object object; 2850 Lisp_Object placeholder; 2851{ 2852 Lisp_Object check_object; 2853 2854 /* We haven't seen any objects when we start. */ 2855 seen_list = Qnil; 2856 2857 /* Make all the substitutions. */ 2858 check_object 2859 = substitute_object_recurse (object, placeholder, object); 2860 2861 /* Clear seen_list because we're done with it. */ 2862 seen_list = Qnil; 2863 2864 /* The returned object here is expected to always eq the 2865 original. */ 2866 if (!EQ (check_object, object)) 2867 error ("Unexpected mutation error in reader"); 2868} 2869 2870/* Feval doesn't get called from here, so no gc protection is needed. */ 2871#define SUBSTITUTE(get_val, set_val) \ 2872{ \ 2873 Lisp_Object old_value = get_val; \ 2874 Lisp_Object true_value \ 2875 = substitute_object_recurse (object, placeholder,\ 2876 old_value); \ 2877 \ 2878 if (!EQ (old_value, true_value)) \ 2879 { \ 2880 set_val; \ 2881 } \ 2882} 2883 2884static Lisp_Object 2885substitute_object_recurse (object, placeholder, subtree) 2886 Lisp_Object object; 2887 Lisp_Object placeholder; 2888 Lisp_Object subtree; 2889{ 2890 /* If we find the placeholder, return the target object. */ 2891 if (EQ (placeholder, subtree)) 2892 return object; 2893 2894 /* If we've been to this node before, don't explore it again. */ 2895 if (!EQ (Qnil, Fmemq (subtree, seen_list))) 2896 return subtree; 2897 2898 /* If this node can be the entry point to a cycle, remember that 2899 we've seen it. It can only be such an entry point if it was made 2900 by #n=, which means that we can find it as a value in 2901 read_objects. */ 2902 if (!EQ (Qnil, Frassq (subtree, read_objects))) 2903 seen_list = Fcons (subtree, seen_list); 2904 2905 /* Recurse according to subtree's type. 2906 Every branch must return a Lisp_Object. */ 2907 switch (XTYPE (subtree)) 2908 { 2909 case Lisp_Vectorlike: 2910 { 2911 int i; 2912 int length = XINT (Flength(subtree)); 2913 for (i = 0; i < length; i++) 2914 { 2915 Lisp_Object idx = make_number (i); 2916 SUBSTITUTE (Faref (subtree, idx), 2917 Faset (subtree, idx, true_value)); 2918 } 2919 return subtree; 2920 } 2921 2922 case Lisp_Cons: 2923 { 2924 SUBSTITUTE (Fcar_safe (subtree), 2925 Fsetcar (subtree, true_value)); 2926 SUBSTITUTE (Fcdr_safe (subtree), 2927 Fsetcdr (subtree, true_value)); 2928 return subtree; 2929 } 2930 2931 case Lisp_String: 2932 { 2933 /* Check for text properties in each interval. 2934 substitute_in_interval contains part of the logic. */ 2935 2936 INTERVAL root_interval = STRING_INTERVALS (subtree); 2937 Lisp_Object arg = Fcons (object, placeholder); 2938 2939 traverse_intervals_noorder (root_interval, 2940 &substitute_in_interval, arg); 2941 2942 return subtree; 2943 } 2944 2945 /* Other types don't recurse any further. */ 2946 default: 2947 return subtree; 2948 } 2949} 2950 2951/* Helper function for substitute_object_recurse. */ 2952static void 2953substitute_in_interval (interval, arg) 2954 INTERVAL interval; 2955 Lisp_Object arg; 2956{ 2957 Lisp_Object object = Fcar (arg); 2958 Lisp_Object placeholder = Fcdr (arg); 2959 2960 SUBSTITUTE(interval->plist, interval->plist = true_value); 2961} 2962 2963 2964#define LEAD_INT 1 2965#define DOT_CHAR 2 2966#define TRAIL_INT 4 2967#define E_CHAR 8 2968#define EXP_INT 16 2969 2970int 2971isfloat_string (cp) 2972 register char *cp; 2973{ 2974 register int state; 2975 2976 char *start = cp; 2977 2978 state = 0; 2979 if (*cp == '+' || *cp == '-') 2980 cp++; 2981 2982 if (*cp >= '0' && *cp <= '9') 2983 { 2984 state |= LEAD_INT; 2985 while (*cp >= '0' && *cp <= '9') 2986 cp++; 2987 } 2988 if (*cp == '.') 2989 { 2990 state |= DOT_CHAR; 2991 cp++; 2992 } 2993 if (*cp >= '0' && *cp <= '9') 2994 { 2995 state |= TRAIL_INT; 2996 while (*cp >= '0' && *cp <= '9') 2997 cp++; 2998 } 2999 if (*cp == 'e' || *cp == 'E') 3000 { 3001 state |= E_CHAR; 3002 cp++; 3003 if (*cp == '+' || *cp == '-') 3004 cp++; 3005 } 3006 3007 if (*cp >= '0' && *cp <= '9') 3008 { 3009 state |= EXP_INT; 3010 while (*cp >= '0' && *cp <= '9') 3011 cp++; 3012 } 3013 else if (cp == start) 3014 ; 3015 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F') 3016 { 3017 state |= EXP_INT; 3018 cp += 3; 3019 } 3020 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N') 3021 { 3022 state |= EXP_INT; 3023 cp += 3; 3024 } 3025 3026 return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f')) 3027 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT) 3028 || state == (DOT_CHAR|TRAIL_INT) 3029 || state == (LEAD_INT|E_CHAR|EXP_INT) 3030 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT) 3031 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT))); 3032} 3033 3034 3035static Lisp_Object 3036read_vector (readcharfun, bytecodeflag) 3037 Lisp_Object readcharfun; 3038 int bytecodeflag; 3039{ 3040 register int i; 3041 register int size; 3042 register Lisp_Object *ptr; 3043 register Lisp_Object tem, item, vector; 3044 register struct Lisp_Cons *otem; 3045 Lisp_Object len; 3046 3047 tem = read_list (1, readcharfun); 3048 len = Flength (tem); 3049 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil)); 3050 3051 size = XVECTOR (vector)->size; 3052 ptr = XVECTOR (vector)->contents; 3053 for (i = 0; i < size; i++) 3054 { 3055 item = Fcar (tem); 3056 /* If `load-force-doc-strings' is t when reading a lazily-loaded 3057 bytecode object, the docstring containing the bytecode and 3058 constants values must be treated as unibyte and passed to 3059 Fread, to get the actual bytecode string and constants vector. */ 3060 if (bytecodeflag && load_force_doc_strings) 3061 { 3062 if (i == COMPILED_BYTECODE) 3063 { 3064 if (!STRINGP (item)) 3065 error ("Invalid byte code"); 3066 3067 /* Delay handling the bytecode slot until we know whether 3068 it is lazily-loaded (we can tell by whether the 3069 constants slot is nil). */ 3070 ptr[COMPILED_CONSTANTS] = item; 3071 item = Qnil; 3072 } 3073 else if (i == COMPILED_CONSTANTS) 3074 { 3075 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS]; 3076 3077 if (NILP (item)) 3078 { 3079 /* Coerce string to unibyte (like string-as-unibyte, 3080 but without generating extra garbage and 3081 guaranteeing no change in the contents). */ 3082 STRING_SET_CHARS (bytestr, SBYTES (bytestr)); 3083 STRING_SET_UNIBYTE (bytestr); 3084 3085 item = Fread (bytestr); 3086 if (!CONSP (item)) 3087 error ("Invalid byte code"); 3088 3089 otem = XCONS (item); 3090 bytestr = XCAR (item); 3091 item = XCDR (item); 3092 free_cons (otem); 3093 } 3094 3095 /* Now handle the bytecode slot. */ 3096 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr; 3097 } 3098 } 3099 ptr[i] = read_pure ? Fpurecopy (item) : item; 3100 otem = XCONS (tem); 3101 tem = Fcdr (tem); 3102 free_cons (otem); 3103 } 3104 return vector; 3105} 3106 3107/* FLAG = 1 means check for ] to terminate rather than ) and . 3108 FLAG = -1 means check for starting with defun 3109 and make structure pure. */ 3110 3111static Lisp_Object 3112read_list (flag, readcharfun) 3113 int flag; 3114 register Lisp_Object readcharfun; 3115{ 3116 /* -1 means check next element for defun, 3117 0 means don't check, 3118 1 means already checked and found defun. */ 3119 int defunflag = flag < 0 ? -1 : 0; 3120 Lisp_Object val, tail; 3121 register Lisp_Object elt, tem; 3122 struct gcpro gcpro1, gcpro2; 3123 /* 0 is the normal case. 3124 1 means this list is a doc reference; replace it with the number 0. 3125 2 means this list is a doc reference; replace it with the doc string. */ 3126 int doc_reference = 0; 3127 3128 /* Initialize this to 1 if we are reading a list. */ 3129 int first_in_list = flag <= 0; 3130 3131 val = Qnil; 3132 tail = Qnil; 3133 3134 while (1) 3135 { 3136 int ch; 3137 GCPRO2 (val, tail); 3138 elt = read1 (readcharfun, &ch, first_in_list); 3139 UNGCPRO; 3140 3141 first_in_list = 0; 3142 3143 /* While building, if the list starts with #$, treat it specially. */ 3144 if (EQ (elt, Vload_file_name) 3145 && ! NILP (elt) 3146 && !NILP (Vpurify_flag)) 3147 { 3148 if (NILP (Vdoc_file_name)) 3149 /* We have not yet called Snarf-documentation, so assume 3150 this file is described in the DOC-MM.NN file 3151 and Snarf-documentation will fill in the right value later. 3152 For now, replace the whole list with 0. */ 3153 doc_reference = 1; 3154 else 3155 /* We have already called Snarf-documentation, so make a relative 3156 file name for this file, so it can be found properly 3157 in the installed Lisp directory. 3158 We don't use Fexpand_file_name because that would make 3159 the directory absolute now. */ 3160 elt = concat2 (build_string ("../lisp/"), 3161 Ffile_name_nondirectory (elt)); 3162 } 3163 else if (EQ (elt, Vload_file_name) 3164 && ! NILP (elt) 3165 && load_force_doc_strings) 3166 doc_reference = 2; 3167 3168 if (ch) 3169 { 3170 if (flag > 0) 3171 { 3172 if (ch == ']') 3173 return val; 3174 invalid_syntax (") or . in a vector", 18); 3175 } 3176 if (ch == ')') 3177 return val; 3178 if (ch == '.') 3179 { 3180 GCPRO2 (val, tail); 3181 if (!NILP (tail)) 3182 XSETCDR (tail, read0 (readcharfun)); 3183 else 3184 val = read0 (readcharfun); 3185 read1 (readcharfun, &ch, 0); 3186 UNGCPRO; 3187 if (ch == ')') 3188 { 3189 if (doc_reference == 1) 3190 return make_number (0); 3191 if (doc_reference == 2) 3192 { 3193 /* Get a doc string from the file we are loading. 3194 If it's in saved_doc_string, get it from there. */ 3195 int pos = XINT (XCDR (val)); 3196 /* Position is negative for user variables. */ 3197 if (pos < 0) pos = -pos; 3198 if (pos >= saved_doc_string_position 3199 && pos < (saved_doc_string_position 3200 + saved_doc_string_length)) 3201 { 3202 int start = pos - saved_doc_string_position; 3203 int from, to; 3204 3205 /* Process quoting with ^A, 3206 and find the end of the string, 3207 which is marked with ^_ (037). */ 3208 for (from = start, to = start; 3209 saved_doc_string[from] != 037;) 3210 { 3211 int c = saved_doc_string[from++]; 3212 if (c == 1) 3213 { 3214 c = saved_doc_string[from++]; 3215 if (c == 1) 3216 saved_doc_string[to++] = c; 3217 else if (c == '0') 3218 saved_doc_string[to++] = 0; 3219 else if (c == '_') 3220 saved_doc_string[to++] = 037; 3221 } 3222 else 3223 saved_doc_string[to++] = c; 3224 } 3225 3226 return make_string (saved_doc_string + start, 3227 to - start); 3228 } 3229 /* Look in prev_saved_doc_string the same way. */ 3230 else if (pos >= prev_saved_doc_string_position 3231 && pos < (prev_saved_doc_string_position 3232 + prev_saved_doc_string_length)) 3233 { 3234 int start = pos - prev_saved_doc_string_position; 3235 int from, to; 3236 3237 /* Process quoting with ^A, 3238 and find the end of the string, 3239 which is marked with ^_ (037). */ 3240 for (from = start, to = start; 3241 prev_saved_doc_string[from] != 037;) 3242 { 3243 int c = prev_saved_doc_string[from++]; 3244 if (c == 1) 3245 { 3246 c = prev_saved_doc_string[from++]; 3247 if (c == 1) 3248 prev_saved_doc_string[to++] = c; 3249 else if (c == '0') 3250 prev_saved_doc_string[to++] = 0; 3251 else if (c == '_') 3252 prev_saved_doc_string[to++] = 037; 3253 } 3254 else 3255 prev_saved_doc_string[to++] = c; 3256 } 3257 3258 return make_string (prev_saved_doc_string + start, 3259 to - start); 3260 } 3261 else 3262 return get_doc_string (val, 0, 0); 3263 } 3264 3265 return val; 3266 } 3267 invalid_syntax (". in wrong context", 18); 3268 } 3269 invalid_syntax ("] in a list", 11); 3270 } 3271 tem = (read_pure && flag <= 0 3272 ? pure_cons (elt, Qnil) 3273 : Fcons (elt, Qnil)); 3274 if (!NILP (tail)) 3275 XSETCDR (tail, tem); 3276 else 3277 val = tem; 3278 tail = tem; 3279 if (defunflag < 0) 3280 defunflag = EQ (elt, Qdefun); 3281 else if (defunflag > 0) 3282 read_pure = 1; 3283 } 3284} 3285 3286Lisp_Object Vobarray; 3287Lisp_Object initial_obarray; 3288 3289/* oblookup stores the bucket number here, for the sake of Funintern. */ 3290 3291int oblookup_last_bucket_number; 3292 3293static int hash_string (); 3294 3295/* Get an error if OBARRAY is not an obarray. 3296 If it is one, return it. */ 3297 3298Lisp_Object 3299check_obarray (obarray) 3300 Lisp_Object obarray; 3301{ 3302 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) 3303 { 3304 /* If Vobarray is now invalid, force it to be valid. */ 3305 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; 3306 wrong_type_argument (Qvectorp, obarray); 3307 } 3308 return obarray; 3309} 3310 3311/* Intern the C string STR: return a symbol with that name, 3312 interned in the current obarray. */ 3313 3314Lisp_Object 3315intern (str) 3316 const char *str; 3317{ 3318 Lisp_Object tem; 3319 int len = strlen (str); 3320 Lisp_Object obarray; 3321 3322 obarray = Vobarray; 3323 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) 3324 obarray = check_obarray (obarray); 3325 tem = oblookup (obarray, str, len, len); 3326 if (SYMBOLP (tem)) 3327 return tem; 3328 return Fintern (make_string (str, len), obarray); 3329} 3330 3331/* Create an uninterned symbol with name STR. */ 3332 3333Lisp_Object 3334make_symbol (str) 3335 char *str; 3336{ 3337 int len = strlen (str); 3338 3339 return Fmake_symbol ((!NILP (Vpurify_flag) 3340 ? make_pure_string (str, len, len, 0) 3341 : make_string (str, len))); 3342} 3343 3344DEFUN ("intern", Fintern, Sintern, 1, 2, 0, 3345 doc: /* Return the canonical symbol whose name is STRING. 3346If there is none, one is created by this function and returned. 3347A second optional argument specifies the obarray to use; 3348it defaults to the value of `obarray'. */) 3349 (string, obarray) 3350 Lisp_Object string, obarray; 3351{ 3352 register Lisp_Object tem, sym, *ptr; 3353 3354 if (NILP (obarray)) obarray = Vobarray; 3355 obarray = check_obarray (obarray); 3356 3357 CHECK_STRING (string); 3358 3359 tem = oblookup (obarray, SDATA (string), 3360 SCHARS (string), 3361 SBYTES (string)); 3362 if (!INTEGERP (tem)) 3363 return tem; 3364 3365 if (!NILP (Vpurify_flag)) 3366 string = Fpurecopy (string); 3367 sym = Fmake_symbol (string); 3368 3369 if (EQ (obarray, initial_obarray)) 3370 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; 3371 else 3372 XSYMBOL (sym)->interned = SYMBOL_INTERNED; 3373 3374 if ((SREF (string, 0) == ':') 3375 && EQ (obarray, initial_obarray)) 3376 { 3377 XSYMBOL (sym)->constant = 1; 3378 XSYMBOL (sym)->value = sym; 3379 } 3380 3381 ptr = &XVECTOR (obarray)->contents[XINT (tem)]; 3382 if (SYMBOLP (*ptr)) 3383 XSYMBOL (sym)->next = XSYMBOL (*ptr); 3384 else 3385 XSYMBOL (sym)->next = 0; 3386 *ptr = sym; 3387 return sym; 3388} 3389 3390DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0, 3391 doc: /* Return the canonical symbol named NAME, or nil if none exists. 3392NAME may be a string or a symbol. If it is a symbol, that exact 3393symbol is searched for. 3394A second optional argument specifies the obarray to use; 3395it defaults to the value of `obarray'. */) 3396 (name, obarray) 3397 Lisp_Object name, obarray; 3398{ 3399 register Lisp_Object tem, string; 3400 3401 if (NILP (obarray)) obarray = Vobarray; 3402 obarray = check_obarray (obarray); 3403 3404 if (!SYMBOLP (name)) 3405 { 3406 CHECK_STRING (name); 3407 string = name; 3408 } 3409 else 3410 string = SYMBOL_NAME (name); 3411 3412 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string)); 3413 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem))) 3414 return Qnil; 3415 else 3416 return tem; 3417} 3418 3419DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, 3420 doc: /* Delete the symbol named NAME, if any, from OBARRAY. 3421The value is t if a symbol was found and deleted, nil otherwise. 3422NAME may be a string or a symbol. If it is a symbol, that symbol 3423is deleted, if it belongs to OBARRAY--no other symbol is deleted. 3424OBARRAY defaults to the value of the variable `obarray'. */) 3425 (name, obarray) 3426 Lisp_Object name, obarray; 3427{ 3428 register Lisp_Object string, tem; 3429 int hash; 3430 3431 if (NILP (obarray)) obarray = Vobarray; 3432 obarray = check_obarray (obarray); 3433 3434 if (SYMBOLP (name)) 3435 string = SYMBOL_NAME (name); 3436 else 3437 { 3438 CHECK_STRING (name); 3439 string = name; 3440 } 3441 3442 tem = oblookup (obarray, SDATA (string), 3443 SCHARS (string), 3444 SBYTES (string)); 3445 if (INTEGERP (tem)) 3446 return Qnil; 3447 /* If arg was a symbol, don't delete anything but that symbol itself. */ 3448 if (SYMBOLP (name) && !EQ (name, tem)) 3449 return Qnil; 3450 3451 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; 3452 XSYMBOL (tem)->constant = 0; 3453 XSYMBOL (tem)->indirect_variable = 0; 3454 3455 hash = oblookup_last_bucket_number; 3456 3457 if (EQ (XVECTOR (obarray)->contents[hash], tem)) 3458 { 3459 if (XSYMBOL (tem)->next) 3460 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next); 3461 else 3462 XSETINT (XVECTOR (obarray)->contents[hash], 0); 3463 } 3464 else 3465 { 3466 Lisp_Object tail, following; 3467 3468 for (tail = XVECTOR (obarray)->contents[hash]; 3469 XSYMBOL (tail)->next; 3470 tail = following) 3471 { 3472 XSETSYMBOL (following, XSYMBOL (tail)->next); 3473 if (EQ (following, tem)) 3474 { 3475 XSYMBOL (tail)->next = XSYMBOL (following)->next; 3476 break; 3477 } 3478 } 3479 } 3480 3481 return Qt; 3482} 3483 3484/* Return the symbol in OBARRAY whose names matches the string 3485 of SIZE characters (SIZE_BYTE bytes) at PTR. 3486 If there is no such symbol in OBARRAY, return nil. 3487 3488 Also store the bucket number in oblookup_last_bucket_number. */ 3489 3490Lisp_Object 3491oblookup (obarray, ptr, size, size_byte) 3492 Lisp_Object obarray; 3493 register const char *ptr; 3494 int size, size_byte; 3495{ 3496 int hash; 3497 int obsize; 3498 register Lisp_Object tail; 3499 Lisp_Object bucket, tem; 3500 3501 if (!VECTORP (obarray) 3502 || (obsize = XVECTOR (obarray)->size) == 0) 3503 { 3504 obarray = check_obarray (obarray); 3505 obsize = XVECTOR (obarray)->size; 3506 } 3507 /* This is sometimes needed in the middle of GC. */ 3508 obsize &= ~ARRAY_MARK_FLAG; 3509 /* Combining next two lines breaks VMS C 2.3. */ 3510 hash = hash_string (ptr, size_byte); 3511 hash %= obsize; 3512 bucket = XVECTOR (obarray)->contents[hash]; 3513 oblookup_last_bucket_number = hash; 3514 if (EQ (bucket, make_number (0))) 3515 ; 3516 else if (!SYMBOLP (bucket)) 3517 error ("Bad data in guts of obarray"); /* Like CADR error message */ 3518 else 3519 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) 3520 { 3521 if (SBYTES (SYMBOL_NAME (tail)) == size_byte 3522 && SCHARS (SYMBOL_NAME (tail)) == size 3523 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) 3524 return tail; 3525 else if (XSYMBOL (tail)->next == 0) 3526 break; 3527 } 3528 XSETINT (tem, hash); 3529 return tem; 3530} 3531 3532static int 3533hash_string (ptr, len) 3534 const unsigned char *ptr; 3535 int len; 3536{ 3537 register const unsigned char *p = ptr; 3538 register const unsigned char *end = p + len; 3539 register unsigned char c; 3540 register int hash = 0; 3541 3542 while (p != end) 3543 { 3544 c = *p++; 3545 if (c >= 0140) c -= 40; 3546 hash = ((hash<<3) + (hash>>28) + c); 3547 } 3548 return hash & 07777777777; 3549} 3550 3551void 3552map_obarray (obarray, fn, arg) 3553 Lisp_Object obarray; 3554 void (*fn) P_ ((Lisp_Object, Lisp_Object)); 3555 Lisp_Object arg; 3556{ 3557 register int i; 3558 register Lisp_Object tail; 3559 CHECK_VECTOR (obarray); 3560 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--) 3561 { 3562 tail = XVECTOR (obarray)->contents[i]; 3563 if (SYMBOLP (tail)) 3564 while (1) 3565 { 3566 (*fn) (tail, arg); 3567 if (XSYMBOL (tail)->next == 0) 3568 break; 3569 XSETSYMBOL (tail, XSYMBOL (tail)->next); 3570 } 3571 } 3572} 3573 3574void 3575mapatoms_1 (sym, function) 3576 Lisp_Object sym, function; 3577{ 3578 call1 (function, sym); 3579} 3580 3581DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0, 3582 doc: /* Call FUNCTION on every symbol in OBARRAY. 3583OBARRAY defaults to the value of `obarray'. */) 3584 (function, obarray) 3585 Lisp_Object function, obarray; 3586{ 3587 if (NILP (obarray)) obarray = Vobarray; 3588 obarray = check_obarray (obarray); 3589 3590 map_obarray (obarray, mapatoms_1, function); 3591 return Qnil; 3592} 3593 3594#define OBARRAY_SIZE 1511 3595 3596void 3597init_obarray () 3598{ 3599 Lisp_Object oblength; 3600 int hash; 3601 Lisp_Object *tem; 3602 3603 XSETFASTINT (oblength, OBARRAY_SIZE); 3604 3605 Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0)); 3606 Vobarray = Fmake_vector (oblength, make_number (0)); 3607 initial_obarray = Vobarray; 3608 staticpro (&initial_obarray); 3609 /* Intern nil in the obarray */ 3610 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; 3611 XSYMBOL (Qnil)->constant = 1; 3612 3613 /* These locals are to kludge around a pyramid compiler bug. */ 3614 hash = hash_string ("nil", 3); 3615 /* Separate statement here to avoid VAXC bug. */ 3616 hash %= OBARRAY_SIZE; 3617 tem = &XVECTOR (Vobarray)->contents[hash]; 3618 *tem = Qnil; 3619 3620 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0)); 3621 XSYMBOL (Qnil)->function = Qunbound; 3622 XSYMBOL (Qunbound)->value = Qunbound; 3623 XSYMBOL (Qunbound)->function = Qunbound; 3624 3625 Qt = intern ("t"); 3626 XSYMBOL (Qnil)->value = Qnil; 3627 XSYMBOL (Qnil)->plist = Qnil; 3628 XSYMBOL (Qt)->value = Qt; 3629 XSYMBOL (Qt)->constant = 1; 3630 3631 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ 3632 Vpurify_flag = Qt; 3633 3634 Qvariable_documentation = intern ("variable-documentation"); 3635 staticpro (&Qvariable_documentation); 3636 3637 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH; 3638 read_buffer = (char *) xmalloc (read_buffer_size); 3639} 3640 3641void 3642defsubr (sname) 3643 struct Lisp_Subr *sname; 3644{ 3645 Lisp_Object sym; 3646 sym = intern (sname->symbol_name); 3647 XSETSUBR (XSYMBOL (sym)->function, sname); 3648} 3649 3650#ifdef NOTDEF /* use fset in subr.el now */ 3651void 3652defalias (sname, string) 3653 struct Lisp_Subr *sname; 3654 char *string; 3655{ 3656 Lisp_Object sym; 3657 sym = intern (string); 3658 XSETSUBR (XSYMBOL (sym)->function, sname); 3659} 3660#endif /* NOTDEF */ 3661 3662/* Define an "integer variable"; a symbol whose value is forwarded 3663 to a C variable of type int. Sample call: */ 3664 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */ 3665void 3666defvar_int (namestring, address) 3667 char *namestring; 3668 EMACS_INT *address; 3669{ 3670 Lisp_Object sym, val; 3671 sym = intern (namestring); 3672 val = allocate_misc (); 3673 XMISCTYPE (val) = Lisp_Misc_Intfwd; 3674 XINTFWD (val)->intvar = address; 3675 SET_SYMBOL_VALUE (sym, val); 3676} 3677 3678/* Similar but define a variable whose value is t if address contains 1, 3679 nil if address contains 0 */ 3680void 3681defvar_bool (namestring, address) 3682 char *namestring; 3683 int *address; 3684{ 3685 Lisp_Object sym, val; 3686 sym = intern (namestring); 3687 val = allocate_misc (); 3688 XMISCTYPE (val) = Lisp_Misc_Boolfwd; 3689 XBOOLFWD (val)->boolvar = address; 3690 SET_SYMBOL_VALUE (sym, val); 3691 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); 3692} 3693 3694/* Similar but define a variable whose value is the Lisp Object stored 3695 at address. Two versions: with and without gc-marking of the C 3696 variable. The nopro version is used when that variable will be 3697 gc-marked for some other reason, since marking the same slot twice 3698 can cause trouble with strings. */ 3699void 3700defvar_lisp_nopro (namestring, address) 3701 char *namestring; 3702 Lisp_Object *address; 3703{ 3704 Lisp_Object sym, val; 3705 sym = intern (namestring); 3706 val = allocate_misc (); 3707 XMISCTYPE (val) = Lisp_Misc_Objfwd; 3708 XOBJFWD (val)->objvar = address; 3709 SET_SYMBOL_VALUE (sym, val); 3710} 3711 3712void 3713defvar_lisp (namestring, address) 3714 char *namestring; 3715 Lisp_Object *address; 3716{ 3717 defvar_lisp_nopro (namestring, address); 3718 staticpro (address); 3719} 3720 3721/* Similar but define a variable whose value is the Lisp Object stored in 3722 the current buffer. address is the address of the slot in the buffer 3723 that is current now. */ 3724 3725void 3726defvar_per_buffer (namestring, address, type, doc) 3727 char *namestring; 3728 Lisp_Object *address; 3729 Lisp_Object type; 3730 char *doc; 3731{ 3732 Lisp_Object sym, val; 3733 int offset; 3734 3735 sym = intern (namestring); 3736 val = allocate_misc (); 3737 offset = (char *)address - (char *)current_buffer; 3738 3739 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd; 3740 XBUFFER_OBJFWD (val)->offset = offset; 3741 SET_SYMBOL_VALUE (sym, val); 3742 PER_BUFFER_SYMBOL (offset) = sym; 3743 PER_BUFFER_TYPE (offset) = type; 3744 3745 if (PER_BUFFER_IDX (offset) == 0) 3746 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding 3747 slot of buffer_local_flags */ 3748 abort (); 3749} 3750 3751 3752/* Similar but define a variable whose value is the Lisp Object stored 3753 at a particular offset in the current kboard object. */ 3754 3755void 3756defvar_kboard (namestring, offset) 3757 char *namestring; 3758 int offset; 3759{ 3760 Lisp_Object sym, val; 3761 sym = intern (namestring); 3762 val = allocate_misc (); 3763 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd; 3764 XKBOARD_OBJFWD (val)->offset = offset; 3765 SET_SYMBOL_VALUE (sym, val); 3766} 3767 3768/* Record the value of load-path used at the start of dumping 3769 so we can see if the site changed it later during dumping. */ 3770static Lisp_Object dump_path; 3771 3772void 3773init_lread () 3774{ 3775 char *normal; 3776 int turn_off_warning = 0; 3777 3778 /* Compute the default load-path. */ 3779#ifdef CANNOT_DUMP 3780 normal = PATH_LOADSEARCH; 3781 Vload_path = decode_env_path (0, normal); 3782#else 3783 if (NILP (Vpurify_flag)) 3784 normal = PATH_LOADSEARCH; 3785 else 3786#ifdef EMACS_UNDUMPED 3787 normal = PATH_LOADSEARCH; /* for dumping from universal binary after install */ 3788#else 3789 normal = PATH_DUMPLOADSEARCH; 3790#endif 3791 /* In a dumped Emacs, we normally have to reset the value of 3792 Vload_path from PATH_LOADSEARCH, since the value that was dumped 3793 uses ../lisp, instead of the path of the installed elisp 3794 libraries. However, if it appears that Vload_path was changed 3795 from the default before dumping, don't override that value. */ 3796 if (initialized) 3797 { 3798 if (! NILP (Fequal (dump_path, Vload_path))) 3799 { 3800 Vload_path = decode_env_path (0, normal); 3801 if (!NILP (Vinstallation_directory)) 3802 { 3803 Lisp_Object tem, tem1, sitelisp; 3804 3805 /* Remove site-lisp dirs from path temporarily and store 3806 them in sitelisp, then conc them on at the end so 3807 they're always first in path. */ 3808 sitelisp = Qnil; 3809 while (1) 3810 { 3811 tem = Fcar (Vload_path); 3812 tem1 = Fstring_match (build_string ("site-lisp"), 3813 tem, Qnil); 3814 if (!NILP (tem1)) 3815 { 3816 Vload_path = Fcdr (Vload_path); 3817 sitelisp = Fcons (tem, sitelisp); 3818 } 3819 else 3820 break; 3821 } 3822 3823 /* Add to the path the lisp subdir of the 3824 installation dir, if it exists. */ 3825 tem = Fexpand_file_name (build_string ("lisp"), 3826 Vinstallation_directory); 3827 tem1 = Ffile_exists_p (tem); 3828 if (!NILP (tem1)) 3829 { 3830 if (NILP (Fmember (tem, Vload_path))) 3831 { 3832 turn_off_warning = 1; 3833 Vload_path = Fcons (tem, Vload_path); 3834 } 3835 } 3836 else 3837 /* That dir doesn't exist, so add the build-time 3838 Lisp dirs instead. */ 3839 Vload_path = nconc2 (Vload_path, dump_path); 3840 3841 /* Add leim under the installation dir, if it exists. */ 3842 tem = Fexpand_file_name (build_string ("leim"), 3843 Vinstallation_directory); 3844 tem1 = Ffile_exists_p (tem); 3845 if (!NILP (tem1)) 3846 { 3847 if (NILP (Fmember (tem, Vload_path))) 3848 Vload_path = Fcons (tem, Vload_path); 3849 } 3850 3851 /* Add site-list under the installation dir, if it exists. */ 3852 tem = Fexpand_file_name (build_string ("site-lisp"), 3853 Vinstallation_directory); 3854 tem1 = Ffile_exists_p (tem); 3855 if (!NILP (tem1)) 3856 { 3857 if (NILP (Fmember (tem, Vload_path))) 3858 Vload_path = Fcons (tem, Vload_path); 3859 } 3860 3861 /* If Emacs was not built in the source directory, 3862 and it is run from where it was built, add to load-path 3863 the lisp, leim and site-lisp dirs under that directory. */ 3864 3865 if (NILP (Fequal (Vinstallation_directory, Vsource_directory))) 3866 { 3867 Lisp_Object tem2; 3868 3869 tem = Fexpand_file_name (build_string ("src/Makefile"), 3870 Vinstallation_directory); 3871 tem1 = Ffile_exists_p (tem); 3872 3873 /* Don't be fooled if they moved the entire source tree 3874 AFTER dumping Emacs. If the build directory is indeed 3875 different from the source dir, src/Makefile.in and 3876 src/Makefile will not be found together. */ 3877 tem = Fexpand_file_name (build_string ("src/Makefile.in"), 3878 Vinstallation_directory); 3879 tem2 = Ffile_exists_p (tem); 3880 if (!NILP (tem1) && NILP (tem2)) 3881 { 3882 tem = Fexpand_file_name (build_string ("lisp"), 3883 Vsource_directory); 3884 3885 if (NILP (Fmember (tem, Vload_path))) 3886 Vload_path = Fcons (tem, Vload_path); 3887 3888 tem = Fexpand_file_name (build_string ("leim"), 3889 Vsource_directory); 3890 3891 if (NILP (Fmember (tem, Vload_path))) 3892 Vload_path = Fcons (tem, Vload_path); 3893 3894 tem = Fexpand_file_name (build_string ("site-lisp"), 3895 Vsource_directory); 3896 3897 if (NILP (Fmember (tem, Vload_path))) 3898 Vload_path = Fcons (tem, Vload_path); 3899 } 3900 } 3901 if (!NILP (sitelisp)) 3902 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path); 3903 } 3904 } 3905 } 3906 else 3907 { 3908 /* NORMAL refers to the lisp dir in the source directory. */ 3909 /* We used to add ../lisp at the front here, but 3910 that caused trouble because it was copied from dump_path 3911 into Vload_path, aboe, when Vinstallation_directory was non-nil. 3912 It should be unnecessary. */ 3913 Vload_path = decode_env_path (0, normal); 3914 dump_path = Vload_path; 3915 } 3916#endif 3917 3918#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON)))) 3919 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is 3920 almost never correct, thereby causing a warning to be printed out that 3921 confuses users. Since PATH_LOADSEARCH is always overridden by the 3922 EMACSLOADPATH environment variable below, disable the warning on NT. 3923 Also, when using the "self-contained" option for Carbon Emacs for MacOSX, 3924 the "standard" paths may not exist and would be overridden by 3925 EMACSLOADPATH as on NT. Since this depends on how the executable 3926 was build and packaged, turn off the warnings in general */ 3927 3928 /* Warn if dirs in the *standard* path don't exist. */ 3929 if (!turn_off_warning) 3930 { 3931 Lisp_Object path_tail; 3932 3933 for (path_tail = Vload_path; 3934 !NILP (path_tail); 3935 path_tail = XCDR (path_tail)) 3936 { 3937 Lisp_Object dirfile; 3938 dirfile = Fcar (path_tail); 3939 if (STRINGP (dirfile)) 3940 { 3941 dirfile = Fdirectory_file_name (dirfile); 3942 if (access (SDATA (dirfile), 0) < 0) 3943 dir_warning ("Warning: Lisp directory `%s' does not exist.\n", 3944 XCAR (path_tail)); 3945 } 3946 } 3947 } 3948#endif /* !(WINDOWSNT || HAVE_CARBON) */ 3949 3950 /* If the EMACSLOADPATH environment variable is set, use its value. 3951 This doesn't apply if we're dumping. */ 3952#ifndef CANNOT_DUMP 3953 if (NILP (Vpurify_flag) 3954 && egetenv ("EMACSLOADPATH")) 3955#endif 3956 Vload_path = decode_env_path ("EMACSLOADPATH", normal); 3957 3958 Vvalues = Qnil; 3959 3960 load_in_progress = 0; 3961 Vload_file_name = Qnil; 3962 3963 load_descriptor_list = Qnil; 3964 3965 Vstandard_input = Qt; 3966 Vloads_in_progress = Qnil; 3967} 3968 3969/* Print a warning, using format string FORMAT, that directory DIRNAME 3970 does not exist. Print it on stderr and put it in *Message*. */ 3971 3972void 3973dir_warning (format, dirname) 3974 char *format; 3975 Lisp_Object dirname; 3976{ 3977 char *buffer 3978 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5); 3979 3980 fprintf (stderr, format, SDATA (dirname)); 3981 sprintf (buffer, format, SDATA (dirname)); 3982 /* Don't log the warning before we've initialized!! */ 3983 if (initialized) 3984 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname)); 3985} 3986 3987void 3988syms_of_lread () 3989{ 3990 defsubr (&Sread); 3991 defsubr (&Sread_from_string); 3992 defsubr (&Sintern); 3993 defsubr (&Sintern_soft); 3994 defsubr (&Sunintern); 3995 defsubr (&Sget_load_suffixes); 3996 defsubr (&Sload); 3997 defsubr (&Seval_buffer); 3998 defsubr (&Seval_region); 3999 defsubr (&Sread_char); 4000 defsubr (&Sread_char_exclusive); 4001 defsubr (&Sread_event); 4002 defsubr (&Sget_file_char); 4003 defsubr (&Smapatoms); 4004 defsubr (&Slocate_file_internal); 4005 4006 DEFVAR_LISP ("obarray", &Vobarray, 4007 doc: /* Symbol table for use by `intern' and `read'. 4008It is a vector whose length ought to be prime for best results. 4009The vector's contents don't make sense if examined from Lisp programs; 4010to find all the symbols in an obarray, use `mapatoms'. */); 4011 4012 DEFVAR_LISP ("values", &Vvalues, 4013 doc: /* List of values of all expressions which were read, evaluated and printed. 4014Order is reverse chronological. */); 4015 4016 DEFVAR_LISP ("standard-input", &Vstandard_input, 4017 doc: /* Stream for read to get input from. 4018See documentation of `read' for possible values. */); 4019 Vstandard_input = Qt; 4020 4021 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions, 4022 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'. 4023 4024If this variable is a buffer, then only forms read from that buffer 4025will be added to `read-symbol-positions-list'. 4026If this variable is t, then all read forms will be added. 4027The effect of all other values other than nil are not currently 4028defined, although they may be in the future. 4029 4030The positions are relative to the last call to `read' or 4031`read-from-string'. It is probably a bad idea to set this variable at 4032the toplevel; bind it instead. */); 4033 Vread_with_symbol_positions = Qnil; 4034 4035 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list, 4036 doc: /* A list mapping read symbols to their positions. 4037This variable is modified during calls to `read' or 4038`read-from-string', but only when `read-with-symbol-positions' is 4039non-nil. 4040 4041Each element of the list looks like (SYMBOL . CHAR-POSITION), where 4042CHAR-POSITION is an integer giving the offset of that occurrence of the 4043symbol from the position where `read' or `read-from-string' started. 4044 4045Note that a symbol will appear multiple times in this list, if it was 4046read multiple times. The list is in the same order as the symbols 4047were read in. */); 4048 Vread_symbol_positions_list = Qnil; 4049 4050 DEFVAR_LISP ("load-path", &Vload_path, 4051 doc: /* *List of directories to search for files to load. 4052Each element is a string (directory name) or nil (try default directory). 4053Initialized based on EMACSLOADPATH environment variable, if any, 4054otherwise to default specified by file `epaths.h' when Emacs was built. */); 4055 4056 DEFVAR_LISP ("load-suffixes", &Vload_suffixes, 4057 doc: /* List of suffixes for (compiled or source) Emacs Lisp files. 4058This list should not include the empty string. 4059`load' and related functions try to append these suffixes, in order, 4060to the specified file name if a Lisp suffix is allowed or required. */); 4061 Vload_suffixes = Fcons (build_string (".elc"), 4062 Fcons (build_string (".el"), Qnil)); 4063 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes, 4064 doc: /* List of suffixes that indicate representations of \ 4065the same file. 4066This list should normally start with the empty string. 4067 4068Enabling Auto Compression mode appends the suffixes in 4069`jka-compr-load-suffixes' to this list and disabling Auto Compression 4070mode removes them again. `load' and related functions use this list to 4071determine whether they should look for compressed versions of a file 4072and, if so, which suffixes they should try to append to the file name 4073in order to do so. However, if you want to customize which suffixes 4074the loading functions recognize as compression suffixes, you should 4075customize `jka-compr-load-suffixes' rather than the present variable. */); 4076 /* We don't use empty_string because it's not initialized yet. */ 4077 Vload_file_rep_suffixes = Fcons (build_string (""), Qnil); 4078 4079 DEFVAR_BOOL ("load-in-progress", &load_in_progress, 4080 doc: /* Non-nil iff inside of `load'. */); 4081 4082 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist, 4083 doc: /* An alist of expressions to be evalled when particular files are loaded. 4084Each element looks like (REGEXP-OR-FEATURE FORMS...). 4085 4086REGEXP-OR-FEATURE is either a regular expression to match file names, or 4087a symbol \(a feature name). 4088 4089When `load' is run and the file-name argument matches an element's 4090REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol 4091REGEXP-OR-FEATURE, the FORMS in the element are executed. 4092 4093An error in FORMS does not undo the load, but does prevent execution of 4094the rest of the FORMS. */); 4095 Vafter_load_alist = Qnil; 4096 4097 DEFVAR_LISP ("load-history", &Vload_history, 4098 doc: /* Alist mapping file names to symbols and features. 4099Each alist element is a list that starts with a file name, 4100except for one element (optional) that starts with nil and describes 4101definitions evaluated from buffers not visiting files. 4102 4103The file name is absolute and is the true file name (i.e. it doesn't 4104contain symbolic links) of the loaded file. 4105 4106The remaining elements of each list are symbols defined as variables 4107and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', 4108`(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . SYMBOL)' 4109and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry 4110`(defun . FUNCTION)', and means that SYMBOL was an autoload before 4111this file redefined it as a function. 4112 4113During preloading, the file name recorded is relative to the main Lisp 4114directory. These file names are converted to absolute at startup. */); 4115 Vload_history = Qnil; 4116 4117 DEFVAR_LISP ("load-file-name", &Vload_file_name, 4118 doc: /* Full name of file being loaded by `load'. */); 4119 Vload_file_name = Qnil; 4120 4121 DEFVAR_LISP ("user-init-file", &Vuser_init_file, 4122 doc: /* File name, including directory, of user's initialization file. 4123If the file loaded had extension `.elc', and the corresponding source file 4124exists, this variable contains the name of source file, suitable for use 4125by functions like `custom-save-all' which edit the init file. 4126While Emacs loads and evaluates the init file, value is the real name 4127of the file, regardless of whether or not it has the `.elc' extension. */); 4128 Vuser_init_file = Qnil; 4129 4130 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list, 4131 doc: /* Used for internal purposes by `load'. */); 4132 Vcurrent_load_list = Qnil; 4133 4134 DEFVAR_LISP ("load-read-function", &Vload_read_function, 4135 doc: /* Function used by `load' and `eval-region' for reading expressions. 4136The default is nil, which means use the function `read'. */); 4137 Vload_read_function = Qnil; 4138 4139 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function, 4140 doc: /* Function called in `load' for loading an Emacs Lisp source file. 4141This function is for doing code conversion before reading the source file. 4142If nil, loading is done without any code conversion. 4143Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where 4144 FULLNAME is the full name of FILE. 4145See `load' for the meaning of the remaining arguments. */); 4146 Vload_source_file_function = Qnil; 4147 4148 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings, 4149 doc: /* Non-nil means `load' should force-load all dynamic doc strings. 4150This is useful when the file being loaded is a temporary copy. */); 4151 load_force_doc_strings = 0; 4152 4153 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte, 4154 doc: /* Non-nil means `read' converts strings to unibyte whenever possible. 4155This is normally bound by `load' and `eval-buffer' to control `read', 4156and is not meant for users to change. */); 4157 load_convert_to_unibyte = 0; 4158 4159 DEFVAR_LISP ("source-directory", &Vsource_directory, 4160 doc: /* Directory in which Emacs sources were found when Emacs was built. 4161You cannot count on them to still be there! */); 4162 Vsource_directory 4163 = Fexpand_file_name (build_string ("../"), 4164 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH))); 4165 4166 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list, 4167 doc: /* List of files that were preloaded (when dumping Emacs). */); 4168 Vpreloaded_file_list = Qnil; 4169 4170 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars, 4171 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */); 4172 Vbyte_boolean_vars = Qnil; 4173 4174 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries, 4175 doc: /* Non-nil means load dangerous compiled Lisp files. 4176Some versions of XEmacs use different byte codes than Emacs. These 4177incompatible byte codes can make Emacs crash when it tries to execute 4178them. */); 4179 load_dangerous_libraries = 0; 4180 4181 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp, 4182 doc: /* Regular expression matching safe to load compiled Lisp files. 4183When Emacs loads a compiled Lisp file, it reads the first 512 bytes 4184from the file, and matches them against this regular expression. 4185When the regular expression matches, the file is considered to be safe 4186to load. See also `load-dangerous-libraries'. */); 4187 Vbytecomp_version_regexp 4188 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); 4189 4190 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list, 4191 doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); 4192 Veval_buffer_list = Qnil; 4193 4194 /* Vsource_directory was initialized in init_lread. */ 4195 4196 load_descriptor_list = Qnil; 4197 staticpro (&load_descriptor_list); 4198 4199 Qcurrent_load_list = intern ("current-load-list"); 4200 staticpro (&Qcurrent_load_list); 4201 4202 Qstandard_input = intern ("standard-input"); 4203 staticpro (&Qstandard_input); 4204 4205 Qread_char = intern ("read-char"); 4206 staticpro (&Qread_char); 4207 4208 Qget_file_char = intern ("get-file-char"); 4209 staticpro (&Qget_file_char); 4210 4211 Qbackquote = intern ("`"); 4212 staticpro (&Qbackquote); 4213 Qcomma = intern (","); 4214 staticpro (&Qcomma); 4215 Qcomma_at = intern (",@"); 4216 staticpro (&Qcomma_at); 4217 Qcomma_dot = intern (",."); 4218 staticpro (&Qcomma_dot); 4219 4220 Qinhibit_file_name_operation = intern ("inhibit-file-name-operation"); 4221 staticpro (&Qinhibit_file_name_operation); 4222 4223 Qascii_character = intern ("ascii-character"); 4224 staticpro (&Qascii_character); 4225 4226 Qfunction = intern ("function"); 4227 staticpro (&Qfunction); 4228 4229 Qload = intern ("load"); 4230 staticpro (&Qload); 4231 4232 Qload_file_name = intern ("load-file-name"); 4233 staticpro (&Qload_file_name); 4234 4235 Qeval_buffer_list = intern ("eval-buffer-list"); 4236 staticpro (&Qeval_buffer_list); 4237 4238 Qfile_truename = intern ("file-truename"); 4239 staticpro (&Qfile_truename) ; 4240 4241 Qdo_after_load_evaluation = intern ("do-after-load-evaluation"); 4242 staticpro (&Qdo_after_load_evaluation) ; 4243 4244 staticpro (&dump_path); 4245 4246 staticpro (&read_objects); 4247 read_objects = Qnil; 4248 staticpro (&seen_list); 4249 seen_list = Qnil; 4250 4251 Vloads_in_progress = Qnil; 4252 staticpro (&Vloads_in_progress); 4253} 4254 4255/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d 4256 (do not change this comment) */ 4257