X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/da84f340a4e0e097638464e50035d1bd4804fa51..c9029fe54be0f7b0a6ecfee0528b171d7392b5fe:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 5e373bee9a..70f0a3f2f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,5 +1,5 @@ /* Lisp parsing and input streams. - Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 1999 + Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -21,14 +21,6 @@ Boston, MA 02111-1307, USA. */ #include -/* The following feature selections should be in config.h, but that - causes at best a host of warnings on some systems. */ -#undef _XOPEN_SOURCE /* Avoid warnings about redefinition - in some cases. */ -#define _XOPEN_SOURCE 500 /* for Unix 98 ftello on GNU */ -#undef __EXTENSIONS__ -#define __EXTENSIONS__ /* Keep Solaris 2.6 happy with the - above, else things we need are hidden. */ #include #include #include @@ -42,6 +34,7 @@ Boston, MA 02111-1307, USA. */ #include "commands.h" #include "keyboard.h" #include "termhooks.h" +#include "coding.h" #ifdef lint #include @@ -72,7 +65,7 @@ Boston, MA 02111-1307, USA. */ #define O_RDONLY 0 #endif -#ifdef HAVE_FTELLO +#ifdef HAVE_FSEEKO #define file_offset off_t #define file_tell ftello #else @@ -80,7 +73,9 @@ Boston, MA 02111-1307, USA. */ #define file_tell ftell #endif +#ifndef USE_CRT_DLL extern int errno; +#endif Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list; Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; @@ -97,8 +92,8 @@ int load_in_progress; /* Directory in which the sources were found. */ Lisp_Object Vsource_directory; -/* Search path for files to be loaded. */ -Lisp_Object Vload_path; +/* Search path and suffixes for files to be loaded. */ +Lisp_Object Vload_path, Vload_suffixes, default_suffixes; /* File name of user's init file. */ Lisp_Object Vuser_init_file; @@ -138,6 +133,13 @@ Lisp_Object Vload_source_file_function; /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */ Lisp_Object Vbyte_boolean_vars; +/* Whether or not to add a `read-positions' property to symbols + read. */ +Lisp_Object Vread_with_symbol_positions; + +/* List of (SYMBOL . POSITION) accumulated so far. */ +Lisp_Object Vread_symbol_positions_list; + /* List of descriptors now open for Fload. */ static Lisp_Object load_descriptor_list; @@ -155,6 +157,9 @@ static int read_from_string_limit; /* Number of bytes left to read in the buffer character that `readchar' has already advanced over. */ static int readchar_backlog; +/* Number of characters read in the current call to Fread or + Fread_from_string. */ +static int readchar_count; /* This contains the last string skipped with #@. */ static char *saved_doc_string; @@ -181,13 +186,40 @@ static file_offset prev_saved_doc_string_position; Fread initializes this to zero, so we need not specbind it or worry about what happens to it when there is an error. */ static int new_backquote_flag; + +/* A list of file names for files being loaded in Fload. Used to + check for recursive loads. */ + +static Lisp_Object Vloads_in_progress; + +/* Non-zero means load dangerous compiled Lisp files. */ + +int load_dangerous_libraries; + +/* A regular expression used to detect files compiled with Emacs. */ + +static Lisp_Object Vbytecomp_version_regexp; + +static void to_multibyte P_ ((char **, char **, int *)); +static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, + Lisp_Object (*) (), int, + Lisp_Object, Lisp_Object)); +static Lisp_Object load_unwind P_ ((Lisp_Object)); +static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); + /* Handle unreading and rereading of characters. Write READCHAR to read a character, UNREAD(c) to unread c to be read again. - These macros actually read/unread a byte code, multibyte characters - are not handled here. The caller should manage them if necessary. + The READCHAR and UNREAD macros are meant for reading/unreading a + byte code; they do not handle multibyte characters. The caller + should manage them if necessary. + + [ Actually that seems to be a lie; READCHAR will definitely read + multibyte characters from buffer sources, at least. Is the + comment just out of date? + -- Colin Walters , 22 May 2002 16:36:50 -0400 ] */ #define READCHAR readchar (readcharfun) @@ -200,6 +232,8 @@ readchar (readcharfun) Lisp_Object tem; register int c; + readchar_count++; + if (BUFFERP (readcharfun)) { register struct buffer *inbuffer = XBUFFER (readcharfun); @@ -296,12 +330,10 @@ readchar (readcharfun) { if (read_from_string_index >= read_from_string_limit) c = -1; - else if (STRING_MULTIBYTE (readcharfun)) + else FETCH_STRING_CHAR_ADVANCE (c, readcharfun, read_from_string_index, read_from_string_index_byte); - else - c = XSTRING (readcharfun)->data[read_from_string_index++]; return c; } @@ -321,6 +353,7 @@ unreadchar (readcharfun, c) Lisp_Object readcharfun; int c; { + readchar_count--; if (c == -1) /* Don't back up the pointer if we're unreading the end-of-input mark, since readchar didn't advance it when we read it. */ @@ -375,10 +408,20 @@ unreadchar (readcharfun, c) call1 (readcharfun, make_number (c)); } -static Lisp_Object read0 (), read1 (), read_list (), read_vector (); -static int read_multibyte (); -static Lisp_Object substitute_object_recurse (); -static void substitute_object_in_subtree (), substitute_in_interval (); +static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object, + Lisp_Object)); +static Lisp_Object read0 P_ ((Lisp_Object)); +static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); + +static Lisp_Object read_list P_ ((int, Lisp_Object)); +static Lisp_Object read_vector P_ ((Lisp_Object, int)); +static int read_multibyte P_ ((int, Lisp_Object)); + +static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object, + Lisp_Object)); +static void substitute_object_in_subtree P_ ((Lisp_Object, + Lisp_Object)); +static void substitute_in_interval P_ ((INTERVAL, Lisp_Object)); /* Get a character from the tty. */ @@ -410,6 +453,11 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, { register Lisp_Object val, delayed_switch_frame; +#ifdef HAVE_WINDOW_SYSTEM + if (display_hourglass_p) + cancel_hourglass (); +#endif + delayed_switch_frame = Qnil; /* Read until we get an acceptable event. */ @@ -450,7 +498,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem)))); } } - + /* If we don't have a character now, deal with it appropriately. */ if (!INTEGERP (val)) { @@ -467,24 +515,33 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, if (! NILP (delayed_switch_frame)) unread_switch_frame = delayed_switch_frame; +#if 0 + +#ifdef HAVE_WINDOW_SYSTEM + if (display_hourglass_p) + start_hourglass (); +#endif + +#endif + return val; } DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0, - "Read a character from the command input (keyboard or macro).\n\ -It is returned as a number.\n\ -If the user generates an event which is not a character (i.e. a mouse\n\ -click or function key event), `read-char' signals an error. As an\n\ -exception, switch-frame events are put off until non-ASCII events can\n\ -be read.\n\ -If you want to read non-character events, or ignore them, call\n\ -`read-event' or `read-char-exclusive' instead.\n\ -\n\ -If the optional argument PROMPT is non-nil, display that as a prompt.\n\ -If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\ -input method is turned on in the current buffer, that input method\n\ -is used for reading a character.") - (prompt, inherit_input_method) + doc: /* Read a character from the command input (keyboard or macro). +It is returned as a number. +If the user generates an event which is not a character (i.e. a mouse +click or function key event), `read-char' signals an error. As an +exception, switch-frame events are put off until non-ASCII events can +be read. +If you want to read non-character events, or ignore them, call +`read-event' or `read-char-exclusive' instead. + +If the optional argument PROMPT is non-nil, display that as a prompt. +If the optional argument INHERIT-INPUT-METHOD is non-nil and some +input method is turned on in the current buffer, that input method +is used for reading a character. */) + (prompt, inherit_input_method) Lisp_Object prompt, inherit_input_method; { if (! NILP (prompt)) @@ -493,12 +550,12 @@ is used for reading a character.") } DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0, - "Read an event object from the input stream.\n\ -If the optional argument PROMPT is non-nil, display that as a prompt.\n\ -If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\ -input method is turned on in the current buffer, that input method\n\ -is used for reading a character.") - (prompt, inherit_input_method) + doc: /* Read an event object from the input stream. +If the optional argument PROMPT is non-nil, display that as a prompt. +If the optional argument INHERIT-INPUT-METHOD is non-nil and some +input method is turned on in the current buffer, that input method +is used for reading a character. */) + (prompt, inherit_input_method) Lisp_Object prompt, inherit_input_method; { if (! NILP (prompt)) @@ -507,14 +564,14 @@ is used for reading a character.") } DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0, - "Read a character from the command input (keyboard or macro).\n\ -It is returned as a number. Non-character events are ignored.\n\ -\n\ -If the optional argument PROMPT is non-nil, display that as a prompt.\n\ -If the optional argument INHERIT-INPUT-METHOD is non-nil and some\n\ -input method is turned on in the current buffer, that input method\n\ -is used for reading a character.") - (prompt, inherit_input_method) + doc: /* Read a character from the command input (keyboard or macro). +It is returned as a number. Non-character events are ignored. + +If the optional argument PROMPT is non-nil, display that as a prompt. +If the optional argument INHERIT-INPUT-METHOD is non-nil and some +input method is turned on in the current buffer, that input method +is used for reading a character. */) + (prompt, inherit_input_method) Lisp_Object prompt, inherit_input_method; { if (! NILP (prompt)) @@ -523,27 +580,16 @@ is used for reading a character.") } DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, - "Don't use this yourself.") - () + doc: /* Don't use this yourself. */) + () { register Lisp_Object val; XSETINT (val, getc (instream)); return val; } - -static void readevalloop (); -static Lisp_Object load_unwind (); -static Lisp_Object load_descriptor_unwind (); - -/* Non-zero means load dangerous compiled Lisp files. */ - -int load_dangerous_libraries; - -/* A regular expression used to detect files compiled with Emacs. */ - -static Lisp_Object Vbytecomp_version_regexp; + /* Value is non-zero if the file asswociated with file descriptor FD is a compiled Lisp file that's safe to load. Only files compiled with Emacs are safe to load. Files compiled with XEmacs can lead @@ -581,59 +627,96 @@ safe_to_load_p (fd) } +/* Callback for record_unwind_protect. Restore the old load list OLD, + after loading a file successfully. */ + +static Lisp_Object +record_load_unwind (old) + Lisp_Object old; +{ + return Vloads_in_progress = old; +} + +/* This handler function is used via internal_condition_case_1. */ + +static Lisp_Object +load_error_handler (data) + Lisp_Object data; +{ + return Qnil; +} + DEFUN ("load", Fload, Sload, 1, 5, 0, - "Execute a file of Lisp code named FILE.\n\ -First try FILE with `.elc' appended, then try with `.el',\n\ - then try FILE unmodified.\n\ -This function searches the directories in `load-path'.\n\ -If optional second arg NOERROR is non-nil,\n\ - report no error if FILE doesn't exist.\n\ -Print messages at start and end of loading unless\n\ - optional third arg NOMESSAGE is non-nil.\n\ -If optional fourth arg NOSUFFIX is non-nil, don't try adding\n\ - suffixes `.elc' or `.el' to the specified name FILE.\n\ -If optional fifth arg MUST-SUFFIX is non-nil, insist on\n\ - the suffix `.elc' or `.el'; don't accept just FILE unless\n\ - it ends in one of those suffixes or includes a directory name.\n\ -Return t if file exists.") - (file, noerror, nomessage, nosuffix, must_suffix) + doc: /* Execute a file of Lisp code named FILE. +First try FILE with `.elc' appended, then try with `.el', + then try FILE unmodified (the exact suffixes are determined by +`load-suffixes'). Environment variable references in FILE + are replaced with their values by calling `substitute-in-file-name'. +This function searches the directories in `load-path'. +If optional second arg NOERROR is non-nil, + report no error if FILE doesn't exist. +Print messages at start and end of loading unless + optional third arg NOMESSAGE is non-nil. +If optional fourth arg NOSUFFIX is non-nil, don't try adding + suffixes `.elc' or `.el' to the specified name FILE. +If optional fifth arg MUST-SUFFIX is non-nil, insist on + the suffix `.elc' or `.el'; don't accept just FILE unless + it ends in one of those suffixes or includes a directory name. +Return t if file exists. */) + (file, noerror, nomessage, nosuffix, must_suffix) Lisp_Object file, noerror, nomessage, nosuffix, must_suffix; { register FILE *stream; register int fd = -1; register Lisp_Object lispstream; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); Lisp_Object temp; struct gcpro gcpro1; - Lisp_Object found; + Lisp_Object found, efound; /* 1 means we printed the ".el is newer" message. */ int newer = 0; /* 1 means we are loading a compiled file. */ int compiled = 0; Lisp_Object handler; + int safe_p = 1; char *fmode = "r"; #ifdef DOS_NT fmode = "rt"; #endif /* DOS_NT */ - int safe_p = 1; - CHECK_STRING (file, 0); + CHECK_STRING (file); /* If file name is magic, call the handler. */ - handler = Ffind_file_name_handler (file, Qload); - if (!NILP (handler)) - return call5 (handler, Qload, file, noerror, nomessage, nosuffix); + /* This shouldn't be necessary any more now that `openp' handles it right. + handler = Ffind_file_name_handler (file, Qload); + if (!NILP (handler)) + return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */ /* Do this after the handler to avoid the need to gcpro noerror, nomessage and nosuffix. - (Below here, we care only whether they are nil or not.) */ - file = Fsubstitute_in_file_name (file); + (Below here, we care only whether they are nil or not.) + The presence of this call is the result of a historical accident: + it used to be in every file-operations and when it got removed + everywhere, it accidentally stayed here. Since then, enough people + supposedly have things like (load "$PROJECT/foo.el") in their .emacs + that it seemed risky to remove. */ + if (! NILP (noerror)) + { + file = internal_condition_case_1 (Fsubstitute_in_file_name, file, + Qt, load_error_handler); + if (NILP (file)) + return Qnil; + } + else + file = Fsubstitute_in_file_name (file); + /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file */ - if (XSTRING (file)->size > 0) + if (SCHARS (file) > 0) { - int size = STRING_BYTES (XSTRING (file)); + int size = SBYTES (file); + Lisp_Object tmp[2]; GCPRO1 (file); @@ -641,10 +724,10 @@ Return t if file exists.") { /* Don't insist on adding a suffix if FILE already ends with one. */ if (size > 3 - && !strcmp (XSTRING (file)->data + size - 3, ".el")) + && !strcmp (SDATA (file) + size - 3, ".el")) must_suffix = Qnil; else if (size > 4 - && !strcmp (XSTRING (file)->data + size - 4, ".elc")) + && !strcmp (SDATA (file) + size - 4, ".elc")) must_suffix = Qnil; /* Don't insist on adding a suffix if the argument includes a directory name. */ @@ -653,28 +736,30 @@ Return t if file exists.") } fd = openp (Vload_path, file, - (!NILP (nosuffix) ? "" - : ! NILP (must_suffix) ? ".elc.gz:.elc:.el.gz:.el" - : ".elc:.elc.gz:.el.gz:.el:"), - &found, 0); + (!NILP (nosuffix) ? Qnil + : !NILP (must_suffix) ? Vload_suffixes + : Fappend (2, (tmp[0] = Vload_suffixes, + tmp[1] = default_suffixes, + tmp))), + &found, Qnil); UNGCPRO; } - if (fd < 0) + if (fd == -1) { if (NILP (noerror)) - while (1) - Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), - Fcons (file, Qnil))); + Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), + Fcons (file, Qnil))); else return Qnil; } + /* Tell startup.el whether or not we found the user's init file. */ if (EQ (Qt, Vuser_init_file)) Vuser_init_file = found; - /* If FD is 0, that means openp found a magic file. */ - if (fd == 0) + /* If FD is -2, that means openp found a magic file. */ + if (fd == -2) { if (NILP (Fequal (found, file))) /* If FOUND is a different file name from FILE, @@ -687,70 +772,112 @@ Return t if file exists.") return call5 (handler, Qload, found, noerror, nomessage, Qt); } - /* Load .elc files directly, but not when they are - remote and have no handler! */ - if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]), - ".elc", 4) - && fd != 0) + /* Check if we're stuck in a recursive load cycle. + + 2000-09-21: It's not possible to just check for the file loaded + being a member of Vloads_in_progress. This fails because of the + way the byte compiler currently works; `provide's are not + evaluted, see font-lock.el/jit-lock.el as an example. This + leads to a certain amount of ``normal'' recursion. + + Also, just loading a file recursively is not always an error in + the general case; the second load may do something different. */ + { + int count = 0; + Lisp_Object tem; + for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem)) + if (!NILP (Fequal (found, XCAR (tem)))) + count++; + if (count > 3) + Fsignal (Qerror, Fcons (build_string ("Recursive load"), + Fcons (found, Vloads_in_progress))); + record_unwind_protect (record_load_unwind, Vloads_in_progress); + Vloads_in_progress = Fcons (found, Vloads_in_progress); + } + + if (!bcmp (SDATA (found) + SBYTES (found) - 4, + ".elc", 4)) + /* Load .elc files directly, but not when they are + remote and have no handler! */ { - struct stat s1, s2; - int result; - - if (!safe_to_load_p (fd)) + if (fd != -2) { - safe_p = 0; - if (!load_dangerous_libraries) - error ("File `%s' was not compiled in Emacs", - XSTRING (found)->data); - else if (!NILP (nomessage)) - message_with_string ("File `%s' not compiled in Emacs", found, 1); - } + struct stat s1, s2; + int result; + + if (!safe_to_load_p (fd)) + { + safe_p = 0; + if (!load_dangerous_libraries) + { + if (fd >= 0) + emacs_close (fd); + error ("File `%s' was not compiled in Emacs", + SDATA (found)); + } + else if (!NILP (nomessage)) + message_with_string ("File `%s' not compiled in Emacs", found, 1); + } - compiled = 1; + compiled = 1; + + GCPRO1 (efound); + efound = ENCODE_FILE (found); #ifdef DOS_NT - fmode = "rb"; + fmode = "rb"; #endif /* DOS_NT */ - stat ((char *)XSTRING (found)->data, &s1); - XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 1] = 0; - result = stat ((char *)XSTRING (found)->data, &s2); - if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) - { - /* Make the progress messages mention that source is newer. */ - newer = 1; + stat ((char *)SDATA (efound), &s1); + SSET (efound, SBYTES (efound) - 1, 0); + result = stat ((char *)SDATA (efound), &s2); + SSET (efound, SBYTES (efound) - 1, 'c'); + UNGCPRO; + + if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) + { + /* Make the progress messages mention that source is newer. */ + newer = 1; - /* If we won't print another message, mention this anyway. */ - if (! NILP (nomessage)) - message_with_string ("Source file `%s' newer than byte-compiled file", - found, 1); + /* If we won't print another message, mention this anyway. */ + if (!NILP (nomessage)) + { + Lisp_Object file; + file = Fsubstring (found, make_number (0), make_number (-1)); + message_with_string ("Source file `%s' newer than byte-compiled file", + file, 1); + } + } } - XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 1] = 'c'; } else { - load_source: - /* We are loading a source file (*.el). */ if (!NILP (Vload_source_file_function)) { - if (fd != 0) + Lisp_Object val; + + if (fd >= 0) emacs_close (fd); - return call4 (Vload_source_file_function, found, file, - NILP (noerror) ? Qnil : Qt, - NILP (nomessage) ? Qnil : Qt); + val = call4 (Vload_source_file_function, found, file, + NILP (noerror) ? Qnil : Qt, + NILP (nomessage) ? Qnil : Qt); + return unbind_to (count, val); } } #ifdef WINDOWSNT emacs_close (fd); - stream = fopen ((char *) XSTRING (found)->data, fmode); + GCPRO1 (efound); + efound = ENCODE_FILE (found); + stream = fopen ((char *) SDATA (efound), fmode); + UNGCPRO; #else /* not WINDOWSNT */ stream = fdopen (fd, fmode); #endif /* not WINDOWSNT */ if (stream == 0) { emacs_close (fd); - error ("Failure to create stdio stream for %s", XSTRING (file)->data); + error ("Failure to create stdio stream for %s", SDATA (file)); } if (! NILP (Vpurify_flag)) @@ -772,8 +899,8 @@ Return t if file exists.") GCPRO1 (file); lispstream = Fcons (Qnil, Qnil); - XSETFASTINT (XCAR (lispstream), (EMACS_UINT)stream >> 16); - XSETFASTINT (XCDR (lispstream), (EMACS_UINT)stream & 0xffff); + XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); + XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); record_unwind_protect (load_unwind, lispstream); record_unwind_protect (load_descriptor_unwind, load_descriptor_list); specbind (Qload_file_name, found); @@ -813,6 +940,7 @@ Return t if file exists.") else /* The typical case; compiled file newer than source file. */ message_with_string ("Loading %s...done", file, 1); } + return Qt; } @@ -851,9 +979,9 @@ static int complete_filename_p (pathname) Lisp_Object pathname; { - register unsigned char *s = XSTRING (pathname)->data; + register const unsigned char *s = SDATA (pathname); return (IS_DIRECTORY_SEP (s[0]) - || (XSTRING (pathname)->size > 2 + || (SCHARS (pathname) > 2 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])) #ifdef ALTOS || *s == '@' @@ -864,29 +992,50 @@ complete_filename_p (pathname) ); } +DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0, + doc: /* Search for FILENAME through PATH. +If SUFFIXES is non-nil, it should be a list of suffixes to append to +file name when searching. +If non-nil, PREDICATE is used instead of `file-readable-p'. +PREDICATE can also be an integer to pass to the access(2) function, +in which case file-name-handlers are ignored. */) + (filename, path, suffixes, predicate) + Lisp_Object filename, path, suffixes, predicate; +{ + Lisp_Object file; + int fd = openp (path, filename, suffixes, &file, predicate); + if (NILP (predicate) && fd > 0) + close (fd); + return file; +} + + /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. - SUFFIX is a string containing possible suffixes separated by colons. On success, returns a file descriptor. On failure, returns -1. - EXEC_ONLY nonzero means don't open the files, - just look for one that is executable. In this case, - returns 1 on success. + SUFFIXES is a list of strings containing possible suffixes. + The empty suffix is automatically added iff the list is empty. + + PREDICATE non-nil means don't open the files, + just look for one that satisfies the predicate. In this case, + returns 1 on success. The predicate can be a lisp function or + an integer to pass to `access' (in which case file-name-handlers + are ignored). If STOREPTR is nonzero, it points to a slot where the name of the file actually found should be stored as a Lisp string. nil is stored there on failure. - If the file we find is remote, return 0 - but store the found remote file name in *STOREPTR. - We do not check for remote files if EXEC_ONLY is nonzero. */ + If the file we find is remote, return -2 + but store the found remote file name in *STOREPTR. */ int -openp (path, str, suffix, storeptr, exec_only) +openp (path, str, suffixes, storeptr, predicate) Lisp_Object path, str; - char *suffix; + Lisp_Object suffixes; Lisp_Object *storeptr; - int exec_only; + Lisp_Object predicate; { register int fd; int fn_size = 100; @@ -896,20 +1045,29 @@ openp (path, str, suffix, storeptr, exec_only) int want_size; Lisp_Object filename; struct stat st; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; + Lisp_Object string, tail, encoded_fn; + int max_suffix_len = 0; + + for (tail = suffixes; CONSP (tail); tail = XCDR (tail)) + { + CHECK_STRING_CAR (tail); + max_suffix_len = max (max_suffix_len, + SBYTES (XCAR (tail))); + } + + string = filename = Qnil; + GCPRO6 (str, string, filename, path, suffixes, encoded_fn); - GCPRO1 (str); if (storeptr) *storeptr = Qnil; if (complete_filename_p (str)) absolute = 1; - for (; !NILP (path); path = Fcdr (path)) + for (; CONSP (path); path = XCDR (path)) { - char *nsuffix; - - filename = Fexpand_file_name (str, Fcar (path)); + filename = Fexpand_file_name (str, XCAR (path)); if (!complete_filename_p (filename)) /* If there are non-absolute elts in PATH (eg ".") */ /* Of course, this could conceivably lose if luser sets @@ -923,92 +1081,92 @@ openp (path, str, suffix, storeptr, exec_only) /* Calculate maximum size of any filename made from this path element/specified file name and any possible suffix. */ - want_size = strlen (suffix) + STRING_BYTES (XSTRING (filename)) + 1; + want_size = max_suffix_len + SBYTES (filename) + 1; if (fn_size < want_size) fn = (char *) alloca (fn_size = 100 + want_size); - nsuffix = suffix; - /* Loop over suffixes. */ - while (1) + for (tail = NILP (suffixes) ? default_suffixes : suffixes; + CONSP (tail); tail = XCDR (tail)) { - char *esuffix = (char *) index (nsuffix, ':'); - int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix); + int lsuffix = SBYTES (XCAR (tail)); Lisp_Object handler; + int exists; /* Concatenate path element/specified name with the suffix. If the directory starts with /:, remove that. */ - if (XSTRING (filename)->size > 2 - && XSTRING (filename)->data[0] == '/' - && XSTRING (filename)->data[1] == ':') + if (SCHARS (filename) > 2 + && SREF (filename, 0) == '/' + && SREF (filename, 1) == ':') { - strncpy (fn, XSTRING (filename)->data + 2, - STRING_BYTES (XSTRING (filename)) - 2); - fn[STRING_BYTES (XSTRING (filename)) - 2] = 0; + strncpy (fn, SDATA (filename) + 2, + SBYTES (filename) - 2); + fn[SBYTES (filename) - 2] = 0; } else { - strncpy (fn, XSTRING (filename)->data, - STRING_BYTES (XSTRING (filename))); - fn[STRING_BYTES (XSTRING (filename))] = 0; + strncpy (fn, SDATA (filename), + SBYTES (filename)); + fn[SBYTES (filename)] = 0; } if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ - strncat (fn, nsuffix, lsuffix); + strncat (fn, SDATA (XCAR (tail)), lsuffix); /* Check that the file exists and is not a directory. */ - if (absolute) - handler = Qnil; - else - handler = Ffind_file_name_handler (filename, Qfile_exists_p); - if (! NILP (handler) && ! exec_only) - { - Lisp_Object string; - int exists; - - string = build_string (fn); - exists = ! NILP (exec_only ? Ffile_executable_p (string) - : Ffile_readable_p (string)); - if (exists - && ! NILP (Ffile_directory_p (build_string (fn)))) + /* We used to only check for handlers on non-absolute file names: + if (absolute) + handler = Qnil; + else + handler = Ffind_file_name_handler (filename, Qfile_exists_p); + It's not clear why that was the case and it breaks things like + (load "/bar.el") where the file is actually "/bar.el.gz". */ + handler = Ffind_file_name_handler (filename, Qfile_exists_p); + string = build_string (fn); + if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) + { + if (NILP (predicate)) + exists = !NILP (Ffile_readable_p (string)); + else + exists = !NILP (call1 (predicate, string)); + if (exists && !NILP (Ffile_directory_p (string))) exists = 0; if (exists) { /* We succeeded; return this descriptor and filename. */ if (storeptr) - *storeptr = build_string (fn); + *storeptr = string; UNGCPRO; - return 0; + return -2; } } else { - int exists = (stat (fn, &st) >= 0 - && (st.st_mode & S_IFMT) != S_IFDIR); + const char *pfn; + + encoded_fn = ENCODE_FILE (string); + pfn = SDATA (encoded_fn); + exists = (stat (pfn, &st) >= 0 + && (st.st_mode & S_IFMT) != S_IFDIR); if (exists) { /* Check that we can access or open it. */ - if (exec_only) - fd = (access (fn, X_OK) == 0) ? 1 : -1; + if (NATNUMP (predicate)) + fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1; else - fd = emacs_open (fn, O_RDONLY, 0); + fd = emacs_open (pfn, O_RDONLY, 0); if (fd >= 0) { /* We succeeded; return this descriptor and filename. */ if (storeptr) - *storeptr = build_string (fn); + *storeptr = string; UNGCPRO; return fd; } } } - - /* Advance to next suffix. */ - if (esuffix == 0) - break; - nsuffix += lsuffix + 1; } if (absolute) break; @@ -1037,9 +1195,9 @@ build_load_history (stream, source) tail = Vload_history; prev = Qnil; foundit = 0; - while (!NILP (tail)) + while (CONSP (tail)) { - tem = Fcar (tail); + tem = XCAR (tail); /* Find the feature's previous assoc list... */ if (!NILP (Fequal (source, Fcar (tem)))) @@ -1048,11 +1206,11 @@ build_load_history (stream, source) /* If we're loading, remove it. */ if (loading) - { + { if (NILP (prev)) - Vload_history = Fcdr (tail); + Vload_history = XCDR (tail); else - Fsetcdr (prev, Fcdr (tail)); + Fsetcdr (prev, XCDR (tail)); } /* Otherwise, cons on new symbols that are not already members. */ @@ -1062,20 +1220,20 @@ build_load_history (stream, source) while (CONSP (tem2)) { - newelt = Fcar (tem2); + newelt = XCAR (tem2); - if (NILP (Fmemq (newelt, tem))) - Fsetcar (tail, Fcons (Fcar (tem), - Fcons (newelt, Fcdr (tem)))); + if (NILP (Fmember (newelt, tem))) + Fsetcar (tail, Fcons (XCAR (tem), + Fcons (newelt, XCDR (tem)))); - tem2 = Fcdr (tem2); + tem2 = XCDR (tem2); QUIT; } } } else prev = tail; - tail = Fcdr (tail); + tail = XCDR (tail); QUIT; } @@ -1088,7 +1246,8 @@ build_load_history (stream, source) } Lisp_Object -unreadpure () /* Used as unwind-protect function in readevalloop */ +unreadpure (junk) /* Used as unwind-protect function in readevalloop */ + Lisp_Object junk; { read_pure = 0; return Qnil; @@ -1102,6 +1261,22 @@ readevalloop_1 (old) return Qnil; } +/* Signal an `end-of-file' error, if possible with file name + information. */ + +static void +end_of_file_error () +{ + Lisp_Object data; + + if (STRINGP (Vload_file_name)) + data = Fcons (Vload_file_name, Qnil); + else + data = Qnil; + + Fsignal (Qend_of_file, data); +} + /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. READFUN, if non-nil, is used instead of `read'. */ @@ -1117,9 +1292,10 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read { register int c; register Lisp_Object val; - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); struct gcpro gcpro1; struct buffer *b = 0; + int continue_reading_p; if (BUFFERP (readcharfun)) b = XBUFFER (readcharfun); @@ -1137,7 +1313,8 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read LOADHIST_ATTACH (sourcename); - while (1) + continue_reading_p = 1; + while (continue_reading_p) { if (b != 0 && NILP (b->name)) error ("Reading from killed buffer"); @@ -1157,7 +1334,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read if (!NILP (Vpurify_flag) && c == '(') { - int count1 = specpdl_ptr - specpdl; + int count1 = SPECPDL_INDEX (); record_unwind_protect (unreadpure, Qnil); val = read_list (-1, readcharfun); unbind_to (count1, Qnil); @@ -1166,15 +1343,28 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read { UNREAD (c); read_objects = Qnil; - if (! NILP (readfun)) - val = call1 (readfun, readcharfun); + if (!NILP (readfun)) + { + val = call1 (readfun, readcharfun); + + /* If READCHARFUN has set point to ZV, we should + stop reading, even if the form read sets point + to a different value when evaluated. */ + if (BUFFERP (readcharfun)) + { + struct buffer *b = XBUFFER (readcharfun); + if (BUF_PT (b) == BUF_ZV (b)) + continue_reading_p = 0; + } + } else if (! NILP (Vload_read_function)) val = call1 (Vload_read_function, readcharfun); else - val = read0 (readcharfun); + val = read_internal_start (readcharfun, Qnil, Qnil); } val = (*evalfun) (val); + if (printflag) { Vvalues = Fcons (val, Vvalues); @@ -1192,25 +1382,25 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read } DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "", - "Execute the current buffer as Lisp code.\n\ -Programs can pass two arguments, BUFFER and PRINTFLAG.\n\ -BUFFER is the buffer to evaluate (nil means use current buffer).\n\ -PRINTFLAG controls printing of output:\n\ -nil means discard it; anything else is stream for print.\n\ -\n\ -If the optional third argument FILENAME is non-nil,\n\ -it specifies the file name to use for `load-history'.\n\ -The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'\n\ -for this invocation.\n\ -\n\ -The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that\n\ -`print' and related functions should work normally even if PRINTFLAG is nil.\n\ -\n\ -This function preserves the position of point.") - (buffer, printflag, filename, unibyte, do_allow_print) + doc: /* Execute the current buffer as Lisp code. +Programs can pass two arguments, BUFFER and PRINTFLAG. +BUFFER is the buffer to evaluate (nil means use current buffer). +PRINTFLAG controls printing of output: +nil means discard it; anything else is stream for print. + +If the optional third argument FILENAME is non-nil, +it specifies the file name to use for `load-history'. +The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte' +for this invocation. + +The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that +`print' and related functions should work normally even if PRINTFLAG is nil. + +This function preserves the position of point. */) + (buffer, printflag, filename, unibyte, do_allow_print) Lisp_Object buffer, printflag, filename, unibyte, do_allow_print; { - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); Lisp_Object tem, buf; if (NILP (buffer)) @@ -1237,51 +1427,22 @@ This function preserves the position of point.") return Qnil; } -#if 0 -XDEFUN ("eval-current-buffer", Feval_current_buffer, Seval_current_buffer, 0, 1, "", - "Execute the current buffer as Lisp code.\n\ -Programs can pass argument PRINTFLAG which controls printing of output:\n\ -nil means discard it; anything else is stream for print.\n\ -\n\ -If there is no error, point does not move. If there is an error,\n\ -point remains at the end of the last character read from the buffer.") - (printflag) - Lisp_Object printflag; -{ - int count = specpdl_ptr - specpdl; - Lisp_Object tem, cbuf; - - cbuf = Fcurrent_buffer () - - if (NILP (printflag)) - tem = Qsymbolp; - else - tem = printflag; - specbind (Qstandard_output, tem); - record_unwind_protect (save_excursion_restore, save_excursion_save ()); - SET_PT (BEGV); - readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, - !NILP (printflag), Qnil, Qnil); - return unbind_to (count, Qnil); -} -#endif - DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r", - "Execute the region as Lisp code.\n\ -When called from programs, expects two arguments,\n\ -giving starting and ending indices in the current buffer\n\ -of the text to be executed.\n\ -Programs can pass third argument PRINTFLAG which controls output:\n\ -nil means discard it; anything else is stream for printing it.\n\ -Also the fourth argument READ-FUNCTION, if non-nil, is used\n\ -instead of `read' to read each expression. It gets one argument\n\ -which is the input stream for reading characters.\n\ -\n\ -This function does not move point.") - (start, end, printflag, read_function) + doc: /* Execute the region as Lisp code. +When called from programs, expects two arguments, +giving starting and ending indices in the current buffer +of the text to be executed. +Programs can pass third argument PRINTFLAG which controls output: +nil means discard it; anything else is stream for printing it. +Also the fourth argument READ-FUNCTION, if non-nil, is used +instead of `read' to read each expression. It gets one argument +which is the input stream for reading characters. + +This function does not move point. */) + (start, end, printflag, read_function) Lisp_Object start, end, printflag, read_function; { - int count = specpdl_ptr - specpdl; + int count = SPECPDL_INDEX (); Lisp_Object tem, cbuf; cbuf = Fcurrent_buffer (); @@ -1307,80 +1468,94 @@ This function does not move point.") DEFUN ("read", Fread, Sread, 0, 1, 0, - "Read one Lisp expression as text from STREAM, return as Lisp object.\n\ -If STREAM is nil, use the value of `standard-input' (which see).\n\ -STREAM or the value of `standard-input' may be:\n\ - a buffer (read from point and advance it)\n\ - a marker (read from where it points and advance it)\n\ - a function (call it with no arguments for each character,\n\ - call it with a char as argument to push a char back)\n\ - a string (takes text from string, starting at the beginning)\n\ - t (read text line using minibuffer and use it).") - (stream) + doc: /* Read one Lisp expression as text from STREAM, return as Lisp object. +If STREAM is nil, use the value of `standard-input' (which see). +STREAM or the value of `standard-input' may be: + a buffer (read from point and advance it) + a marker (read from where it points and advance it) + a function (call it with no arguments for each character, + call it with a char as argument to push a char back) + a string (takes text from string, starting at the beginning) + t (read text line using minibuffer and use it, or read from + standard input in batch mode). */) + (stream) Lisp_Object stream; { - extern Lisp_Object Fread_minibuffer (); - if (NILP (stream)) stream = Vstandard_input; if (EQ (stream, Qt)) stream = Qread_char; - - readchar_backlog = -1; - new_backquote_flag = 0; - read_objects = Qnil; - if (EQ (stream, Qread_char)) return Fread_minibuffer (build_string ("Lisp expression: "), Qnil); - if (STRINGP (stream)) - return Fcar (Fread_from_string (stream, Qnil, Qnil)); - - return read0 (stream); + return read_internal_start (stream, Qnil, Qnil); } DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, - "Read one Lisp expression which is represented as text by STRING.\n\ -Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).\n\ -START and END optionally delimit a substring of STRING from which to read;\n\ - they default to 0 and (length STRING) respectively.") - (string, start, end) + doc: /* Read one Lisp expression which is represented as text by STRING. +Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX). +START and END optionally delimit a substring of STRING from which to read; + they default to 0 and (length STRING) respectively. */) + (string, start, end) Lisp_Object string, start, end; { - int startval, endval; - Lisp_Object tem; + Lisp_Object ret; + CHECK_STRING (string); + /* read_internal_start sets read_from_string_index. */ + ret = read_internal_start (string, start, end); + return Fcons (ret, make_number (read_from_string_index)); +} - CHECK_STRING (string,0); +/* Function to set up the global context we need in toplevel read + calls. */ +static Lisp_Object +read_internal_start (stream, start, end) + Lisp_Object stream; + Lisp_Object start; /* Only used when stream is a string. */ + Lisp_Object end; /* Only used when stream is a string. */ +{ + Lisp_Object retval; - if (NILP (end)) - endval = XSTRING (string)->size; - else - { - CHECK_NUMBER (end, 2); - endval = XINT (end); - if (endval < 0 || endval > XSTRING (string)->size) - args_out_of_range (string, end); - } + readchar_backlog = -1; + readchar_count = 0; + new_backquote_flag = 0; + read_objects = Qnil; + if (EQ (Vread_with_symbol_positions, Qt) + || EQ (Vread_with_symbol_positions, stream)) + Vread_symbol_positions_list = Qnil; - if (NILP (start)) - startval = 0; - else + if (STRINGP (stream)) { - CHECK_NUMBER (start, 1); - startval = XINT (start); - if (startval < 0 || startval > endval) - args_out_of_range (string, start); - } - - read_from_string_index = startval; - read_from_string_index_byte = string_char_to_byte (string, startval); - read_from_string_limit = endval; + int startval, endval; + if (NILP (end)) + endval = SCHARS (stream); + else + { + CHECK_NUMBER (end); + endval = XINT (end); + if (endval < 0 || endval > SCHARS (stream)) + args_out_of_range (stream, end); + } - new_backquote_flag = 0; - read_objects = Qnil; + if (NILP (start)) + startval = 0; + else + { + CHECK_NUMBER (start); + startval = XINT (start); + if (startval < 0 || startval > endval) + args_out_of_range (stream, start); + } + read_from_string_index = startval; + read_from_string_index_byte = string_char_to_byte (stream, startval); + read_from_string_limit = endval; + } - tem = read0 (string); - return Fcons (tem, make_number (read_from_string_index)); + retval = read0 (stream); + if (EQ (Vread_with_symbol_positions, Qt) + || EQ (Vread_with_symbol_positions, stream)) + Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list); + return retval; } /* Use this for recursive reads, in contexts where internal tokens @@ -1418,27 +1593,47 @@ read_multibyte (c, readcharfun) characters. */ unsigned char str[MAX_MULTIBYTE_LENGTH]; int len = 0; + int bytes; + + if (c < 0) + return c; str[len++] = c; while ((c = READCHAR) >= 0xA0 && len < MAX_MULTIBYTE_LENGTH) - str[len++] = c; + { + str[len++] = c; + readchar_count--; + } UNREAD (c); - return STRING_CHAR (str, len); + if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes)) + return STRING_CHAR (str, len); + /* The byte sequence is not valid as multibyte. Unread all bytes + but the first one, and return the first byte. */ + while (--len > 0) + UNREAD (str[len]); + return str[0]; } -/* Read a \-escape sequence, assuming we already read the `\'. */ +/* Read a \-escape sequence, assuming we already read the `\'. + If the escape sequence forces unibyte, store 1 into *BYTEREP. + If the escape sequence forces multibyte, store 2 into *BYTEREP. + Otherwise store 0 into *BYTEREP. */ static int -read_escape (readcharfun, stringp) +read_escape (readcharfun, stringp, byterep) Lisp_Object readcharfun; int stringp; + int *byterep; { register int c = READCHAR; + + *byterep = 0; + switch (c) { case -1: - error ("End of file"); + end_of_file_error (); case 'a': return '\007'; @@ -1471,7 +1666,7 @@ read_escape (readcharfun, stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, byterep); return c | meta_modifier; case 'S': @@ -1480,7 +1675,7 @@ read_escape (readcharfun, stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, byterep); return c | shift_modifier; case 'H': @@ -1489,7 +1684,7 @@ read_escape (readcharfun, stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, byterep); return c | hyper_modifier; case 'A': @@ -1498,16 +1693,20 @@ read_escape (readcharfun, stringp) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, byterep); return c | alt_modifier; case 's': + if (stringp) + return ' '; c = READCHAR; - if (c != '-') - error ("Invalid escape character syntax"); + if (c != '-') { + UNREAD (c); + return ' '; + } c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, byterep); return c | super_modifier; case 'C': @@ -1517,7 +1716,7 @@ read_escape (readcharfun, stringp) case '^': c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, byterep); if ((c & ~CHAR_MODIFIER_MASK) == '?') return 0177 | (c & CHAR_MODIFIER_MASK); else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) @@ -1556,6 +1755,8 @@ read_escape (readcharfun, stringp) break; } } + + *byterep = 1; return i; } @@ -1586,6 +1787,8 @@ read_escape (readcharfun, stringp) break; } } + + *byterep = 2; return i; } @@ -1596,6 +1799,110 @@ read_escape (readcharfun, stringp) } } + +/* Read an integer in radix RADIX using READCHARFUN to read + characters. RADIX must be in the interval [2..36]; if it isn't, a + read error is signaled . Value is the integer read. Signals an + error if encountering invalid read syntax or if RADIX is out of + range. */ + +static Lisp_Object +read_integer (readcharfun, radix) + Lisp_Object readcharfun; + int radix; +{ + int ndigits = 0, invalid_p, c, sign = 0; + EMACS_INT number = 0; + + if (radix < 2 || radix > 36) + invalid_p = 1; + else + { + number = ndigits = invalid_p = 0; + sign = 1; + + c = READCHAR; + if (c == '-') + { + c = READCHAR; + sign = -1; + } + else if (c == '+') + c = READCHAR; + + while (c >= 0) + { + int digit; + + if (c >= '0' && c <= '9') + digit = c - '0'; + else if (c >= 'a' && c <= 'z') + digit = c - 'a' + 10; + else if (c >= 'A' && c <= 'Z') + digit = c - 'A' + 10; + else + { + UNREAD (c); + break; + } + + if (digit < 0 || digit >= radix) + invalid_p = 1; + + number = radix * number + digit; + ++ndigits; + c = READCHAR; + } + } + + if (ndigits == 0 || invalid_p) + { + char buf[50]; + sprintf (buf, "integer, radix %d", radix); + Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil)); + } + + return make_number (sign * number); +} + + +/* Convert unibyte text in read_buffer to multibyte. + + Initially, *P is a pointer after the end of the unibyte text, and + the pointer *END points after the end of read_buffer. + + If read_buffer doesn't have enough room to hold the result + of the conversion, reallocate it and adjust *P and *END. + + At the end, make *P point after the result of the conversion, and + return in *NCHARS the number of characters in the converted + text. */ + +static void +to_multibyte (p, end, nchars) + char **p, **end; + int *nchars; +{ + int nbytes; + + parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars); + if (read_buffer_size < 2 * nbytes) + { + int offset = *p - read_buffer; + read_buffer_size = 2 * max (read_buffer_size, nbytes); + read_buffer = (char *) xrealloc (read_buffer, read_buffer_size); + *p = read_buffer + offset; + *end = read_buffer + read_buffer_size; + } + + if (nbytes != *nchars) + nbytes = str_as_multibyte (read_buffer, read_buffer_size, + *p - read_buffer, nchars); + + *p = read_buffer + nbytes; +} + + /* If the next token is ')' or ']' or '.', we store that character in *PCH and the return value is not interesting. Else, we store zero in *PCH and we read and return one lisp object. @@ -1616,7 +1923,8 @@ read1 (readcharfun, pch, first_in_list) retry: c = READCHAR; - if (c < 0) return Fsignal (Qend_of_file, Qnil); + if (c < 0) + end_of_file_error (); switch (c) { @@ -1680,17 +1988,17 @@ read1 (readcharfun, pch, first_in_list) UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); - if (size_in_chars != XSTRING (tmp)->size + if (size_in_chars != SCHARS (tmp) /* We used to print 1 char too many when the number of bits was a multiple of 8. Accept such input in case it came from an old version. */ && ! (XFASTINT (length) - == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR)) + == (SCHARS (tmp) - 1) * BITS_PER_CHAR)) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), Qnil)); - + val = Fmake_bool_vector (length, Qnil); - bcopy (XSTRING (tmp)->data, XBOOL_VECTOR (val)->data, + bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, size_in_chars); /* Clear the extraneous bits in the last byte. */ if (XINT (length) != size_in_chars * BITS_PER_CHAR) @@ -1727,6 +2035,7 @@ read1 (readcharfun, pch, first_in_list) Lisp_Object beg, end, plist; beg = read1 (readcharfun, &ch, 0); + end = plist = Qnil; if (ch == ')') break; if (ch == 0) @@ -1742,7 +2051,7 @@ read1 (readcharfun, pch, first_in_list) UNGCPRO; return tmp; } - + /* #@NUMBER is used to skip NUMBER following characters. That's used in .elc files to skip over doc strings and function definitions. */ @@ -1759,7 +2068,7 @@ read1 (readcharfun, pch, first_in_list) } if (c >= 0) UNREAD (c); - + if (load_force_doc_strings && EQ (readcharfun, Qget_file_char)) { /* If we are supposed to force doc strings into core right now, @@ -1814,6 +2123,14 @@ read1 (readcharfun, pch, first_in_list) goto retry; } + if (c == '!') + { + /* #! appears at the beginning of an executable file. + Skip the first line. */ + while (c != '\n') + c = READCHAR; + goto retry; + } if (c == '$') return Vload_file_name; if (c == '\'') @@ -1857,7 +2174,7 @@ read1 (readcharfun, pch, first_in_list) /* ...and #n# will use the real value from now on. */ Fsetcdr (cell, tem); - + return tem; } /* #n# returns a previously read object. */ @@ -1868,8 +2185,17 @@ read1 (readcharfun, pch, first_in_list) return XCDR (tem); /* Fall through to error message. */ } + else if (c == 'r' || c == 'R') + return read_integer (readcharfun, n); + /* Fall through to error message. */ } + else if (c == 'x' || c == 'X') + return read_integer (readcharfun, 16); + else if (c == 'o' || c == 'O') + return read_integer (readcharfun, 8); + else if (c == 'b' || c == 'B') + return read_integer (readcharfun, 2); UNREAD (c); Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); @@ -1890,9 +2216,9 @@ read1 (readcharfun, pch, first_in_list) { Lisp_Object value; - new_backquote_flag = 1; + new_backquote_flag++; value = read0 (readcharfun); - new_backquote_flag = 0; + new_backquote_flag--; return Fcons (Qbackquote, Fcons (value, Qnil)); } @@ -1914,9 +2240,9 @@ read1 (readcharfun, pch, first_in_list) comma_type = Qcomma; } - new_backquote_flag = 0; + new_backquote_flag--; value = read0 (readcharfun); - new_backquote_flag = 1; + new_backquote_flag++; return Fcons (comma_type, Fcons (value, Qnil)); } else @@ -1924,45 +2250,85 @@ read1 (readcharfun, pch, first_in_list) case '?': { + int discard; + int next_char; + int ok; + c = READCHAR; - if (c < 0) return Fsignal (Qend_of_file, Qnil); + if (c < 0) + end_of_file_error (); + + /* Accept `single space' syntax like (list ? x) where the + whitespace character is SPC or TAB. + Other literal whitespace like NL, CR, and FF are not accepted, + as there are well-established escape sequences for these. */ + if (c == ' ' || c == '\t') + return make_number (c); if (c == '\\') - c = read_escape (readcharfun, 0); + c = read_escape (readcharfun, 0, &discard); else if (BASE_LEADING_CODE_P (c)) c = read_multibyte (c, readcharfun); + next_char = READCHAR; + if (next_char == '.') + { + /* Only a dotted-pair dot is valid after a char constant. */ + int next_next_char = READCHAR; + UNREAD (next_next_char); + + ok = (next_next_char <= 040 + || index ("\"';([#?", next_next_char) + || (!first_in_list && next_next_char == '`') + || (new_backquote_flag && next_next_char == ',')); + } + else + { + ok = (next_char <= 040 + || index ("\"';()[]#?", next_char) + || (!first_in_list && next_char == '`') + || (new_backquote_flag && next_char == ',')); + } + UNREAD (next_char); + if (!ok) + Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil)); + return make_number (c); } case '"': { - register char *p = read_buffer; - register char *end = read_buffer + read_buffer_size; + char *p = read_buffer; + char *end = read_buffer + read_buffer_size; register int c; - /* Nonzero if we saw an escape sequence specifying - a multibyte character. */ + /* 1 if we saw an escape sequence specifying + a multibyte character, or a multibyte character. */ int force_multibyte = 0; - /* Nonzero if we saw an escape sequence specifying + /* 1 if we saw an escape sequence specifying a single-byte character. */ int force_singlebyte = 0; + /* 1 if read_buffer contains multibyte text now. */ + int is_multibyte = 0; int cancel = 0; - int nchars; + int nchars = 0; while ((c = READCHAR) >= 0 && c != '\"') { if (end - p < MAX_MULTIBYTE_LENGTH) { - char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2); - p += new - read_buffer; - read_buffer += new - read_buffer; + int offset = p - read_buffer; + read_buffer = (char *) xrealloc (read_buffer, + read_buffer_size *= 2); + p = read_buffer + offset; end = read_buffer + read_buffer_size; } if (c == '\\') { - c = read_escape (readcharfun, 1); + int byterep; + + c = read_escape (readcharfun, 1, &byterep); /* C is -1 if \ newline has just been seen */ if (c == -1) @@ -1972,48 +2338,55 @@ read1 (readcharfun, pch, first_in_list) continue; } - /* If an escape specifies a non-ASCII single-byte character, - this must be a unibyte string. */ - if (SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)) - && ! ASCII_BYTE_P ((c & ~CHAR_MODIFIER_MASK))) + if (byterep == 1) force_singlebyte = 1; + else if (byterep == 2) + force_multibyte = 1; } - if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) + /* A character that must be multibyte forces multibyte. */ + if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK)) + force_multibyte = 1; + + /* If we just discovered the need to be multibyte, + convert the text accumulated thus far. */ + if (force_multibyte && ! is_multibyte) { - /* Any modifiers for a multibyte character are invalid. */ - if (c & CHAR_MODIFIER_MASK) - error ("Invalid modifier in string"); - p += CHAR_STRING (c, p); - force_multibyte = 1; + is_multibyte = 1; + to_multibyte (&p, &end, &nchars); } - else - { - /* Allow `\C- ' and `\C-?'. */ - if (c == (CHAR_CTL | ' ')) - c = 0; - else if (c == (CHAR_CTL | '?')) - c = 127; - if (c & CHAR_SHIFT) - { - /* Shift modifier is valid only with [A-Za-z]. */ - if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') - c &= ~CHAR_SHIFT; - else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') - c = (c & ~CHAR_SHIFT) - ('a' - 'A'); - } + /* Allow `\C- ' and `\C-?'. */ + if (c == (CHAR_CTL | ' ')) + c = 0; + else if (c == (CHAR_CTL | '?')) + c = 127; - if (c & CHAR_META) - /* Move the meta bit to the right place for a string. */ - c = (c & ~CHAR_META) | 0x80; - if (c & ~0xff) - error ("Invalid modifier in string"); - *p++ = c; + if (c & CHAR_SHIFT) + { + /* Shift modifier is valid only with [A-Za-z]. */ + if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') + c &= ~CHAR_SHIFT; + else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') + c = (c & ~CHAR_SHIFT) - ('a' - 'A'); } + + if (c & CHAR_META) + /* Move the meta bit to the right place for a string. */ + c = (c & ~CHAR_META) | 0x80; + if (c & CHAR_MODIFIER_MASK) + error ("Invalid modifier in string"); + + if (is_multibyte) + p += CHAR_STRING (c, p); + else + *p++ = c; + + nchars++; } + if (c < 0) - return Fsignal (Qend_of_file, Qnil); + end_of_file_error (); /* If purifying, and string starts with \ newline, return zero instead. This is for doc strings @@ -2021,52 +2394,60 @@ read1 (readcharfun, pch, first_in_list) if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) return make_number (0); - if (force_multibyte) - nchars = multibyte_chars_in_text (read_buffer, p - read_buffer); - else if (force_singlebyte) - nchars = p - read_buffer; + if (is_multibyte || force_singlebyte) + ; else if (load_convert_to_unibyte) { Lisp_Object string; - nchars = multibyte_chars_in_text (read_buffer, p - read_buffer); + to_multibyte (&p, &end, &nchars); if (p - read_buffer != nchars) { string = make_multibyte_string (read_buffer, nchars, p - read_buffer); return Fstring_make_unibyte (string); } + /* We can make a unibyte string directly. */ + is_multibyte = 0; } else if (EQ (readcharfun, Qget_file_char) || EQ (readcharfun, Qlambda)) - /* Nowadays, reading directly from a file - is used only for compiled Emacs Lisp files, - and those always use the Emacs internal encoding. - Meanwhile, Qlambda is used for reading dynamic byte code - (compiled with byte-compile-dynamic = t). */ - nchars = multibyte_chars_in_text (read_buffer, p - read_buffer); + { + /* Nowadays, reading directly from a file is used only for + compiled Emacs Lisp files, and those always use the + Emacs internal encoding. Meanwhile, Qlambda is used + for reading dynamic byte code (compiled with + byte-compile-dynamic = t). So make the string multibyte + if the string contains any multibyte sequences. + (to_multibyte is a no-op if not.) */ + to_multibyte (&p, &end, &nchars); + is_multibyte = (p - read_buffer) != nchars; + } else /* In all other cases, if we read these bytes as separate characters, treat them as separate characters now. */ - nchars = p - read_buffer; + ; + /* We want readchar_count to be the number of characters, not + bytes. Hence we adjust for multibyte characters in the + string. ... But it doesn't seem to be necessary, because + READCHAR *does* read multibyte characters from buffers. */ + /* readchar_count -= (p - read_buffer) - nchars; */ if (read_pure) return make_pure_string (read_buffer, nchars, p - read_buffer, - (force_multibyte - || (p - read_buffer != nchars))); + is_multibyte); return make_specified_string (read_buffer, nchars, p - read_buffer, - (force_multibyte - || (p - read_buffer != nchars))); + is_multibyte); } case '.': { - /* If a period is followed by a number, then we should read it - as a floating point number. Otherwise, it denotes a dotted - pair. */ int next_char = READCHAR; UNREAD (next_char); - if (! (next_char >= '0' && next_char <= '9')) + if (next_char <= 040 + || index ("\"';([#?", next_char) + || (!first_in_list && next_char == '`') + || (new_backquote_flag && next_char == ',')) { *pch = c; return Qnil; @@ -2080,28 +2461,31 @@ read1 (readcharfun, pch, first_in_list) default_label: if (c <= 040) goto retry; { - register char *p = read_buffer; + char *p = read_buffer; int quoted = 0; { - register char *end = read_buffer + read_buffer_size; + char *end = read_buffer + read_buffer_size; while (c > 040 - && !(c == '\"' || c == '\'' || c == ';' || c == '?' - || c == '(' || c == ')' - || c == '[' || c == ']' || c == '#' - )) + && !index ("\"';()[]#", c) + && !(!first_in_list && c == '`') + && !(new_backquote_flag && c == ',')) { if (end - p < MAX_MULTIBYTE_LENGTH) { - register char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2); - p += new - read_buffer; - read_buffer += new - read_buffer; + int offset = p - read_buffer; + read_buffer = (char *) xrealloc (read_buffer, + read_buffer_size *= 2); + p = read_buffer + offset; end = read_buffer + read_buffer_size; } + if (c == '\\') { c = READCHAR; + if (c == -1) + end_of_file_error (); quoted = 1; } @@ -2115,10 +2499,11 @@ read1 (readcharfun, pch, first_in_list) if (p == end) { - char *new = (char *) xrealloc (read_buffer, read_buffer_size *= 2); - p += new - read_buffer; - read_buffer += new - read_buffer; -/* end = read_buffer + read_buffer_size; */ + int offset = p - read_buffer; + read_buffer = (char *) xrealloc (read_buffer, + read_buffer_size *= 2); + p = read_buffer + offset; + end = read_buffer + read_buffer_size; } *p = 0; if (c >= 0) @@ -2184,11 +2569,21 @@ read1 (readcharfun, pch, first_in_list) return make_float (negative ? - value : value); } } - - if (uninterned_symbol) - return make_symbol (read_buffer); - else - return intern (read_buffer); + { + Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer) + : intern (read_buffer); + if (EQ (Vread_with_symbol_positions, Qt) + || EQ (Vread_with_symbol_positions, readcharfun)) + Vread_symbol_positions_list = + /* Kind of a hack; this will probably fail if characters + in the symbol name were escaped. Not really a big + deal, though. */ + Fcons (Fcons (result, + make_number (readchar_count + - XFASTINT (Flength (Fsymbol_name (result))))), + Vread_symbol_positions_list); + return result; + } } } } @@ -2210,7 +2605,7 @@ substitute_object_in_subtree (object, placeholder) /* Make all the substitutions. */ check_object = substitute_object_recurse (object, placeholder, object); - + /* Clear seen_list because we're done with it. */ seen_list = Qnil; @@ -2254,7 +2649,7 @@ substitute_object_recurse (object, placeholder, subtree) read_objects. */ if (!EQ (Qnil, Frassq (subtree, read_objects))) seen_list = Fcons (subtree, seen_list); - + /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ switch (XTYPE (subtree)) @@ -2262,12 +2657,12 @@ substitute_object_recurse (object, placeholder, subtree) case Lisp_Vectorlike: { int i; - int length = Flength(subtree); + int length = XINT (Flength(subtree)); for (i = 0; i < length; i++) { Lisp_Object idx = make_number (i); SUBSTITUTE (Faref (subtree, idx), - Faset (subtree, idx, true_value)); + Faset (subtree, idx, true_value)); } return subtree; } @@ -2275,22 +2670,22 @@ substitute_object_recurse (object, placeholder, subtree) case Lisp_Cons: { SUBSTITUTE (Fcar_safe (subtree), - Fsetcar (subtree, true_value)); + Fsetcar (subtree, true_value)); SUBSTITUTE (Fcdr_safe (subtree), - Fsetcdr (subtree, true_value)); + Fsetcdr (subtree, true_value)); return subtree; } case Lisp_String: { /* Check for text properties in each interval. - substitute_in_interval contains part of the logic. */ + substitute_in_interval contains part of the logic. */ - INTERVAL root_interval = XSTRING (subtree)->intervals; + INTERVAL root_interval = STRING_INTERVALS (subtree); Lisp_Object arg = Fcons (object, placeholder); - - traverse_intervals (root_interval, 1, 0, - &substitute_in_interval, arg); + + traverse_intervals_noorder (root_interval, + &substitute_in_interval, arg); return subtree; } @@ -2325,7 +2720,7 @@ isfloat_string (cp) register char *cp; { register int state; - + char *start = cp; state = 0; @@ -2432,8 +2827,8 @@ read_vector (readcharfun, bytecodeflag) /* Coerce string to unibyte (like string-as-unibyte, but without generating extra garbage and guaranteeing no change in the contents). */ - XSTRING (bytestr)->size = STRING_BYTES (XSTRING (bytestr)); - SET_STRING_BYTES (XSTRING (bytestr), -1); + STRING_SET_CHARS (bytestr, SBYTES (bytestr)); + STRING_SET_UNIBYTE (bytestr); item = Fread (bytestr); if (!CONSP (item)) @@ -2456,7 +2851,7 @@ read_vector (readcharfun, bytecodeflag) } return vector; } - + /* FLAG = 1 means check for ] to terminate rather than ) and . FLAG = -1 means check for starting with defun and make structure pure. */ @@ -2475,7 +2870,7 @@ read_list (flag, readcharfun) struct gcpro gcpro1, gcpro2; /* 0 is the normal case. 1 means this list is a doc reference; replace it with the number 0. - 2 means this list is a doc reference; replace it with the doc string. */ + 2 means this list is a doc reference; replace it with the doc string. */ int doc_reference = 0; /* Initialize this to 1 if we are reading a list. */ @@ -2533,7 +2928,7 @@ read_list (flag, readcharfun) { GCPRO2 (val, tail); if (!NILP (tail)) - XCDR (tail) = read0 (readcharfun); + XSETCDR (tail, read0 (readcharfun)); else val = read0 (readcharfun); read1 (readcharfun, &ch, 0); @@ -2626,7 +3021,7 @@ read_list (flag, readcharfun) ? pure_cons (elt, Qnil) : Fcons (elt, Qnil)); if (!NILP (tail)) - XCDR (tail) = tem; + XSETCDR (tail, tem); else val = tem; tail = tem; @@ -2645,7 +3040,6 @@ Lisp_Object initial_obarray; int oblookup_last_bucket_number; static int hash_string (); -Lisp_Object oblookup (); /* Get an error if OBARRAY is not an obarray. If it is one, return it. */ @@ -2669,7 +3063,7 @@ check_obarray (obarray) Lisp_Object intern (str) - char *str; + const char *str; { Lisp_Object tem; int len = strlen (str); @@ -2698,11 +3092,11 @@ make_symbol (str) } DEFUN ("intern", Fintern, Sintern, 1, 2, 0, - "Return the canonical symbol whose name is STRING.\n\ -If there is none, one is created by this function and returned.\n\ -A second optional argument specifies the obarray to use;\n\ -it defaults to the value of `obarray'.") - (string, obarray) + doc: /* Return the canonical symbol whose name is STRING. +If there is none, one is created by this function and returned. +A second optional argument specifies the obarray to use; +it defaults to the value of `obarray'. */) + (string, obarray) Lisp_Object string, obarray; { register Lisp_Object tem, sym, *ptr; @@ -2710,22 +3104,29 @@ it defaults to the value of `obarray'.") if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); - CHECK_STRING (string, 0); + CHECK_STRING (string); - tem = oblookup (obarray, XSTRING (string)->data, - XSTRING (string)->size, - STRING_BYTES (XSTRING (string))); + tem = oblookup (obarray, SDATA (string), + SCHARS (string), + SBYTES (string)); if (!INTEGERP (tem)) return tem; if (!NILP (Vpurify_flag)) string = Fpurecopy (string); sym = Fmake_symbol (string); - XSYMBOL (sym)->obarray = obarray; - if ((XSTRING (string)->data[0] == ':') + if (EQ (obarray, initial_obarray)) + XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; + else + XSYMBOL (sym)->interned = SYMBOL_INTERNED; + + if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) - XSYMBOL (sym)->value = sym; + { + XSYMBOL (sym)->constant = 1; + XSYMBOL (sym)->value = sym; + } ptr = &XVECTOR (obarray)->contents[XINT (tem)]; if (SYMBOLP (*ptr)) @@ -2737,29 +3138,28 @@ it defaults to the value of `obarray'.") } DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0, - "Return the canonical symbol named NAME, or nil if none exists.\n\ -NAME may be a string or a symbol. If it is a symbol, that exact\n\ -symbol is searched for.\n\ -A second optional argument specifies the obarray to use;\n\ -it defaults to the value of `obarray'.") - (name, obarray) + doc: /* Return the canonical symbol named NAME, or nil if none exists. +NAME may be a string or a symbol. If it is a symbol, that exact +symbol is searched for. +A second optional argument specifies the obarray to use; +it defaults to the value of `obarray'. */) + (name, obarray) Lisp_Object name, obarray; { - register Lisp_Object tem; - struct Lisp_String *string; + register Lisp_Object tem, string; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); if (!SYMBOLP (name)) { - CHECK_STRING (name, 0); - string = XSTRING (name); + CHECK_STRING (name); + string = name; } else - string = XSYMBOL (name)->name; + string = SYMBOL_NAME (name); - tem = oblookup (obarray, string->data, string->size, STRING_BYTES (string)); + tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string)); if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem))) return Qnil; else @@ -2767,12 +3167,12 @@ it defaults to the value of `obarray'.") } DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, - "Delete the symbol named NAME, if any, from OBARRAY.\n\ -The value is t if a symbol was found and deleted, nil otherwise.\n\ -NAME may be a string or a symbol. If it is a symbol, that symbol\n\ -is deleted, if it belongs to OBARRAY--no other symbol is deleted.\n\ -OBARRAY defaults to the value of the variable `obarray'.") - (name, obarray) + doc: /* Delete the symbol named NAME, if any, from OBARRAY. +The value is t if a symbol was found and deleted, nil otherwise. +NAME may be a string or a symbol. If it is a symbol, that symbol +is deleted, if it belongs to OBARRAY--no other symbol is deleted. +OBARRAY defaults to the value of the variable `obarray'. */) + (name, obarray) Lisp_Object name, obarray; { register Lisp_Object string, tem; @@ -2782,23 +3182,25 @@ OBARRAY defaults to the value of the variable `obarray'.") obarray = check_obarray (obarray); if (SYMBOLP (name)) - XSETSTRING (string, XSYMBOL (name)->name); + string = SYMBOL_NAME (name); else { - CHECK_STRING (name, 0); + CHECK_STRING (name); string = name; } - tem = oblookup (obarray, XSTRING (string)->data, - XSTRING (string)->size, - STRING_BYTES (XSTRING (string))); + tem = oblookup (obarray, SDATA (string), + SCHARS (string), + SBYTES (string)); if (INTEGERP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ if (SYMBOLP (name) && !EQ (name, tem)) return Qnil; - XSYMBOL (tem)->obarray = Qnil; + XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; + XSYMBOL (tem)->constant = 0; + XSYMBOL (tem)->indirect_variable = 0; hash = oblookup_last_bucket_number; @@ -2838,7 +3240,7 @@ OBARRAY defaults to the value of the variable `obarray'.") Lisp_Object oblookup (obarray, ptr, size, size_byte) Lisp_Object obarray; - register char *ptr; + register const char *ptr; int size, size_byte; { int hash; @@ -2866,9 +3268,9 @@ oblookup (obarray, ptr, size, size_byte) else for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) { - if (STRING_BYTES (XSYMBOL (tail)->name) == size_byte - && XSYMBOL (tail)->name->size == size - && !bcmp (XSYMBOL (tail)->name->data, ptr, size_byte)) + if (SBYTES (SYMBOL_NAME (tail)) == size_byte + && SCHARS (SYMBOL_NAME (tail)) == size + && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) return tail; else if (XSYMBOL (tail)->next == 0) break; @@ -2879,11 +3281,11 @@ oblookup (obarray, ptr, size, size_byte) static int hash_string (ptr, len) - unsigned char *ptr; + const unsigned char *ptr; int len; { - register unsigned char *p = ptr; - register unsigned char *end = p + len; + register const unsigned char *p = ptr; + register const unsigned char *end = p + len; register unsigned char c; register int hash = 0; @@ -2904,7 +3306,7 @@ map_obarray (obarray, fn, arg) { register int i; register Lisp_Object tail; - CHECK_VECTOR (obarray, 1); + CHECK_VECTOR (obarray); for (i = XVECTOR (obarray)->size - 1; i >= 0; i--) { tail = XVECTOR (obarray)->contents[i]; @@ -2927,9 +3329,9 @@ mapatoms_1 (sym, function) } DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0, - "Call FUNCTION on every symbol in OBARRAY.\n\ -OBARRAY defaults to the value of `obarray'.") - (function, obarray) + doc: /* Call FUNCTION on every symbol in OBARRAY. +OBARRAY defaults to the value of `obarray'. */) + (function, obarray) Lisp_Object function, obarray; { if (NILP (obarray)) obarray = Vobarray; @@ -2955,7 +3357,9 @@ init_obarray () initial_obarray = Vobarray; staticpro (&initial_obarray); /* Intern nil in the obarray */ - XSYMBOL (Qnil)->obarray = Vobarray; + XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; + XSYMBOL (Qnil)->constant = 1; + /* These locals are to kludge around a pyramid compiler bug. */ hash = hash_string ("nil", 3); /* Separate statement here to avoid VAXC bug. */ @@ -2972,6 +3376,7 @@ init_obarray () XSYMBOL (Qnil)->value = Qnil; XSYMBOL (Qnil)->plist = Qnil; XSYMBOL (Qt)->value = Qt; + XSYMBOL (Qt)->constant = 1; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ Vpurify_flag = Qt; @@ -3006,22 +3411,22 @@ defalias (sname, string) /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type int. Sample call: */ - /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */ + /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */ void defvar_int (namestring, address) char *namestring; - int *address; + EMACS_INT *address; { Lisp_Object sym, val; sym = intern (namestring); val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Intfwd; XINTFWD (val)->intvar = address; - XSYMBOL (sym)->value = val; + SET_SYMBOL_VALUE (sym, val); } -/* Similar but define a variable whose value is T if address contains 1, - NIL if address contains 0 */ +/* Similar but define a variable whose value is t if address contains 1, + nil if address contains 0 */ void defvar_bool (namestring, address) char *namestring; @@ -3032,7 +3437,7 @@ defvar_bool (namestring, address) val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Boolfwd; XBOOLFWD (val)->boolvar = address; - XSYMBOL (sym)->value = val; + SET_SYMBOL_VALUE (sym, val); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -3051,7 +3456,7 @@ defvar_lisp_nopro (namestring, address) val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Objfwd; XOBJFWD (val)->objvar = address; - XSYMBOL (sym)->value = val; + SET_SYMBOL_VALUE (sym, val); } void @@ -3084,10 +3489,11 @@ defvar_per_buffer (namestring, address, type, doc) XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd; XBUFFER_OBJFWD (val)->offset = offset; - XSYMBOL (sym)->value = val; - *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym; - *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type; - if (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)) == 0) + SET_SYMBOL_VALUE (sym, val); + PER_BUFFER_SYMBOL (offset) = sym; + PER_BUFFER_TYPE (offset) = type; + + if (PER_BUFFER_IDX (offset) == 0) /* Did a DEFVAR_PER_BUFFER without initializing the corresponding slot of buffer_local_flags */ abort (); @@ -3107,7 +3513,7 @@ defvar_kboard (namestring, offset) val = allocate_misc (); XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd; XKBOARD_OBJFWD (val)->offset = offset; - XSYMBOL (sym)->value = val; + SET_SYMBOL_VALUE (sym, val); } /* Record the value of load-path used at the start of dumping @@ -3142,9 +3548,28 @@ init_lread () Vload_path = decode_env_path (0, normal); if (!NILP (Vinstallation_directory)) { + Lisp_Object tem, tem1, sitelisp; + + /* Remove site-lisp dirs from path temporarily and store + them in sitelisp, then conc them on at the end so + they're always first in path. */ + sitelisp = Qnil; + while (1) + { + tem = Fcar (Vload_path); + tem1 = Fstring_match (build_string ("site-lisp"), + tem, Qnil); + if (!NILP (tem1)) + { + Vload_path = Fcdr (Vload_path); + sitelisp = Fcons (tem, sitelisp); + } + else + break; + } + /* Add to the path the lisp subdir of the installation dir, if it exists. */ - Lisp_Object tem, tem1; tem = Fexpand_file_name (build_string ("lisp"), Vinstallation_directory); tem1 = Ffile_exists_p (tem); @@ -3153,7 +3578,7 @@ init_lread () if (NILP (Fmember (tem, Vload_path))) { turn_off_warning = 1; - Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); + Vload_path = Fcons (tem, Vload_path); } } else @@ -3168,7 +3593,7 @@ init_lread () if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) - Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); + Vload_path = Fcons (tem, Vload_path); } /* Add site-list under the installation dir, if it exists. */ @@ -3178,7 +3603,7 @@ init_lread () if (!NILP (tem1)) { if (NILP (Fmember (tem, Vload_path))) - Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); + Vload_path = Fcons (tem, Vload_path); } /* If Emacs was not built in the source directory, @@ -3206,21 +3631,23 @@ init_lread () Vsource_directory); if (NILP (Fmember (tem, Vload_path))) - Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); + Vload_path = Fcons (tem, Vload_path); tem = Fexpand_file_name (build_string ("leim"), Vsource_directory); if (NILP (Fmember (tem, Vload_path))) - Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); + Vload_path = Fcons (tem, Vload_path); tem = Fexpand_file_name (build_string ("site-lisp"), Vsource_directory); if (NILP (Fmember (tem, Vload_path))) - Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil)); + Vload_path = Fcons (tem, Vload_path); } } + if (!NILP (sitelisp)) + Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path); } } } @@ -3237,8 +3664,8 @@ init_lread () #endif #ifndef WINDOWSNT - /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is - almost never correct, thereby causing a warning to be printed out that + /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is + almost never correct, thereby causing a warning to be printed out that confuses users. Since PATH_LOADSEARCH is always overridden by the EMACSLOADPATH environment variable below, disable the warning on NT. */ @@ -3256,7 +3683,7 @@ init_lread () if (STRINGP (dirfile)) { dirfile = Fdirectory_file_name (dirfile); - if (access (XSTRING (dirfile)->data, 0) < 0) + if (access (SDATA (dirfile), 0) < 0) dir_warning ("Warning: Lisp directory `%s' does not exist.\n", XCAR (path_tail)); } @@ -3280,6 +3707,7 @@ init_lread () load_descriptor_list = Qnil; Vstandard_input = Qt; + Vloads_in_progress = Qnil; } /* Print a warning, using format string FORMAT, that directory DIRNAME @@ -3291,10 +3719,10 @@ dir_warning (format, dirname) Lisp_Object dirname; { char *buffer - = (char *) alloca (XSTRING (dirname)->size + strlen (format) + 5); + = (char *) alloca (SCHARS (dirname) + strlen (format) + 5); - fprintf (stderr, format, XSTRING (dirname)->data); - sprintf (buffer, format, XSTRING (dirname)->data); + fprintf (stderr, format, SDATA (dirname)); + sprintf (buffer, format, SDATA (dirname)); /* Don't log the warning before we've initialized!! */ if (initialized) message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname)); @@ -3316,115 +3744,167 @@ syms_of_lread () defsubr (&Sread_event); defsubr (&Sget_file_char); defsubr (&Smapatoms); + defsubr (&Slocate_file_internal); DEFVAR_LISP ("obarray", &Vobarray, - "Symbol table for use by `intern' and `read'.\n\ -It is a vector whose length ought to be prime for best results.\n\ -The vector's contents don't make sense if examined from Lisp programs;\n\ -to find all the symbols in an obarray, use `mapatoms'."); + doc: /* Symbol table for use by `intern' and `read'. +It is a vector whose length ought to be prime for best results. +The vector's contents don't make sense if examined from Lisp programs; +to find all the symbols in an obarray, use `mapatoms'. */); DEFVAR_LISP ("values", &Vvalues, - "List of values of all expressions which were read, evaluated and printed.\n\ -Order is reverse chronological."); + doc: /* List of values of all expressions which were read, evaluated and printed. +Order is reverse chronological. */); DEFVAR_LISP ("standard-input", &Vstandard_input, - "Stream for read to get input from.\n\ -See documentation of `read' for possible values."); + doc: /* Stream for read to get input from. +See documentation of `read' for possible values. */); Vstandard_input = Qt; + DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions, + doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'. + +If this variable is a buffer, then only forms read from that buffer +will be added to `read-symbol-positions-list'. +If this variable is t, then all read forms will be added. +The effect of all other values other than nil are not currently +defined, although they may be in the future. + +The positions are relative to the last call to `read' or +`read-from-string'. It is probably a bad idea to set this variable at +the toplevel; bind it instead. */); + Vread_with_symbol_positions = Qnil; + + DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list, + doc: /* A list mapping read symbols to their positions. +This variable is modified during calls to `read' or +`read-from-string', but only when `read-with-symbol-positions' is +non-nil. + +Each element of the list looks like (SYMBOL . CHAR-POSITION), where +CHAR-POSITION is an integer giving the offset of that occurrence of the +symbol from the position where `read' or `read-from-string' started. + +Note that a symbol will appear multiple times in this list, if it was +read multiple times. The list is in the same order as the symbols +were read in. */); + Vread_symbol_positions_list = Qnil; + DEFVAR_LISP ("load-path", &Vload_path, - "*List of directories to search for files to load.\n\ -Each element is a string (directory name) or nil (try default directory).\n\ -Initialized based on EMACSLOADPATH environment variable, if any,\n\ -otherwise to default specified by file `epaths.h' when Emacs was built."); + doc: /* *List of directories to search for files to load. +Each element is a string (directory name) or nil (try default directory). +Initialized based on EMACSLOADPATH environment variable, if any, +otherwise to default specified by file `epaths.h' when Emacs was built. */); + + DEFVAR_LISP ("load-suffixes", &Vload_suffixes, + doc: /* *List of suffixes to try for files to load. +This list should not include the empty string. */); + Vload_suffixes = Fcons (build_string (".elc"), + Fcons (build_string (".el"), Qnil)); + /* We don't use empty_string because it's not initialized yet. */ + default_suffixes = Fcons (build_string (""), Qnil); + staticpro (&default_suffixes); DEFVAR_BOOL ("load-in-progress", &load_in_progress, - "Non-nil iff inside of `load'."); + doc: /* Non-nil iff inside of `load'. */); DEFVAR_LISP ("after-load-alist", &Vafter_load_alist, - "An alist of expressions to be evalled when particular files are loaded.\n\ -Each element looks like (FILENAME FORMS...).\n\ -When `load' is run and the file-name argument is FILENAME,\n\ -the FORMS in the corresponding element are executed at the end of loading.\n\n\ -FILENAME must match exactly! Normally FILENAME is the name of a library,\n\ -with no directory specified, since that is how `load' is normally called.\n\ -An error in FORMS does not undo the load,\n\ -but does prevent execution of the rest of the FORMS."); + doc: /* An alist of expressions to be evalled when particular files are loaded. +Each element looks like (FILENAME FORMS...). +When `load' is run and the file-name argument is FILENAME, +the FORMS in the corresponding element are executed at the end of loading. + +FILENAME must match exactly! Normally FILENAME is the name of a library, +with no directory specified, since that is how `load' is normally called. +An error in FORMS does not undo the load, +but does prevent execution of the rest of the FORMS. +FILENAME can also be a symbol (a feature) and FORMS are then executed +when the corresponding call to `provide' is made. */); Vafter_load_alist = Qnil; DEFVAR_LISP ("load-history", &Vload_history, - "Alist mapping source file names to symbols and features.\n\ -Each alist element is a list that starts with a file name,\n\ -except for one element (optional) that starts with nil and describes\n\ -definitions evaluated from buffers not visiting files.\n\ -The remaining elements of each list are symbols defined as functions\n\ -or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'."); + doc: /* Alist mapping source file names to symbols and features. +Each alist element is a list that starts with a file name, +except for one element (optional) that starts with nil and describes +definitions evaluated from buffers not visiting files. +The remaining elements of each list are symbols defined as functions, +and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', +`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'. +An element `(t . SYMBOL)' precedes an entry that is just SYMBOL, +and means that SYMBOL was an autoload before this file redefined it +as a function. */); Vload_history = Qnil; DEFVAR_LISP ("load-file-name", &Vload_file_name, - "Full name of file being loaded by `load'."); + doc: /* Full name of file being loaded by `load'. */); Vload_file_name = Qnil; DEFVAR_LISP ("user-init-file", &Vuser_init_file, - "File name, including directory, of user's initialization file.\n\ -If the file loaded had extension `.elc' and there was a corresponding `.el'\n\ -file, this variable contains the name of the .el file, suitable for use\n\ -by functions like `custom-save-all' which edit the init file."); + doc: /* File name, including directory, of user's initialization file. +If the file loaded had extension `.elc' and there was a corresponding `.el' +file, this variable contains the name of the .el file, suitable for use +by functions like `custom-save-all' which edit the init file. */); Vuser_init_file = Qnil; DEFVAR_LISP ("current-load-list", &Vcurrent_load_list, - "Used for internal purposes by `load'."); + doc: /* Used for internal purposes by `load'. */); Vcurrent_load_list = Qnil; DEFVAR_LISP ("load-read-function", &Vload_read_function, - "Function used by `load' and `eval-region' for reading expressions.\n\ -The default is nil, which means use the function `read'."); + doc: /* Function used by `load' and `eval-region' for reading expressions. +The default is nil, which means use the function `read'. */); Vload_read_function = Qnil; DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function, - "Function called in `load' for loading an Emacs lisp source file.\n\ -This function is for doing code conversion before reading the source file.\n\ -If nil, loading is done without any code conversion.\n\ -Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where\n\ - FULLNAME is the full name of FILE.\n\ -See `load' for the meaning of the remaining arguments."); + doc: /* Function called in `load' for loading an Emacs lisp source file. +This function is for doing code conversion before reading the source file. +If nil, loading is done without any code conversion. +Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where + FULLNAME is the full name of FILE. +See `load' for the meaning of the remaining arguments. */); Vload_source_file_function = Qnil; DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings, - "Non-nil means `load' should force-load all dynamic doc strings.\n\ -This is useful when the file being loaded is a temporary copy."); + doc: /* Non-nil means `load' should force-load all dynamic doc strings. +This is useful when the file being loaded is a temporary copy. */); load_force_doc_strings = 0; DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte, - "Non-nil means `load' converts strings to unibyte whenever possible.\n\ -This is normally used in `load-with-code-conversion'\n\ -for loading non-compiled files."); + doc: /* Non-nil means `read' converts strings to unibyte whenever possible. +This is normally bound by `load' and `eval-buffer' to control `read', +and is not meant for users to change. */); load_convert_to_unibyte = 0; DEFVAR_LISP ("source-directory", &Vsource_directory, - "Directory in which Emacs sources were found when Emacs was built.\n\ -You cannot count on them to still be there!"); + doc: /* Directory in which Emacs sources were found when Emacs was built. +You cannot count on them to still be there! */); Vsource_directory = Fexpand_file_name (build_string ("../"), Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH))); DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list, - "List of files that were preloaded (when dumping Emacs)."); + doc: /* List of files that were preloaded (when dumping Emacs). */); Vpreloaded_file_list = Qnil; DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars, - "List of all DEFVAR_BOOL variables, used by the byte code optimizer."); + doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */); Vbyte_boolean_vars = Qnil; DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries, - "Non-nil means load dangerous compiled Lisp files.\n\ -Some versions of XEmacs use different byte codes than Emacs. These\n\ -incompatible byte codes can make Emacs crash when it tries to execute\n\ -them."); + doc: /* Non-nil means load dangerous compiled Lisp files. +Some versions of XEmacs use different byte codes than Emacs. These +incompatible byte codes can make Emacs crash when it tries to execute +them. */); load_dangerous_libraries = 0; - Vbytecomp_version_regexp = build_string ("^;;;.in Emacs version"); - staticpro (&Vbytecomp_version_regexp); + DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp, + doc: /* Regular expression matching safe to load compiled Lisp files. +When Emacs loads a compiled Lisp file, it reads the first 512 bytes +from the file, and matches them against this regular expression. +When the regular expression matches, the file is considered to be safe +to load. See also `load-dangerous-libraries'. */); + Vbytecomp_version_regexp + = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); /* Vsource_directory was initialized in init_lread. */ @@ -3472,5 +3952,7 @@ them."); staticpro (&read_objects); read_objects = Qnil; staticpro (&seen_list); - + + Vloads_in_progress = Qnil; + staticpro (&Vloads_in_progress); }