X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e63304b745e5f27ce84e74b1d0766174437db5ce..7b48cc1354a2efff9fb528c1b3c78f47d001178e:/src/lread.c diff --git a/src/lread.c b/src/lread.c index c60064bc7a..892c102c58 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,6 +1,7 @@ /* Lisp parsing and input streams. - Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, + 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +17,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -61,6 +62,9 @@ Boston, MA 02111-1307, USA. */ #include #endif /* HAVE_SETLOCALE */ +#ifdef HAVE_FCNTL_H +#include +#endif #ifndef O_RDONLY #define O_RDONLY 0 #endif @@ -82,18 +86,19 @@ Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist Lisp_Object Qascii_character, Qload, Qload_file_name; Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; Lisp_Object Qinhibit_file_name_operation; +Lisp_Object Qeval_buffer_list, Veval_buffer_list; extern Lisp_Object Qevent_symbol_element_mask; extern Lisp_Object Qfile_exists_p; -/* non-zero if inside `load' */ +/* non-zero iff inside `load' */ int load_in_progress; /* Directory in which the sources were found. */ Lisp_Object Vsource_directory; /* Search path and suffixes for files to be loaded. */ -Lisp_Object Vload_path, Vload_suffixes, default_suffixes; +Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes; /* File name of user's init file. */ Lisp_Object Vuser_init_file; @@ -203,6 +208,7 @@ 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, Lisp_Object, Lisp_Object)); static Lisp_Object load_unwind P_ ((Lisp_Object)); static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); @@ -215,7 +221,7 @@ static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); 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? @@ -233,7 +239,7 @@ readchar (readcharfun) register int c; readchar_count++; - + if (BUFFERP (readcharfun)) { register struct buffer *inbuffer = XBUFFER (readcharfun); @@ -319,6 +325,7 @@ readchar (readcharfun) /* Interrupted reads have been observed while reading over the network */ while (c == EOF && ferror (instream) && errno == EINTR) { + QUIT; clearerr (instream); c = getc (instream); } @@ -411,7 +418,7 @@ unreadchar (readcharfun, c) 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 read1 P_ ((Lisp_Object, int *, int)); static Lisp_Object read_list P_ ((int, Lisp_Object)); static Lisp_Object read_vector P_ ((Lisp_Object, int)); @@ -457,7 +464,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, if (display_hourglass_p) cancel_hourglass (); #endif - + delayed_switch_frame = Qnil; /* Read until we get an acceptable event. */ @@ -498,7 +505,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)) { @@ -637,33 +644,81 @@ record_load_unwind (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 ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, + doc: /* Return the suffixes that `load' should try if a suffix is \ +required. +This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) + () +{ + Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; + while (CONSP (suffixes)) + { + Lisp_Object exts = Vload_file_rep_suffixes; + suffix = XCAR (suffixes); + suffixes = XCDR (suffixes); + while (CONSP (exts)) + { + ext = XCAR (exts); + exts = XCDR (exts); + lst = Fcons (concat2 (suffix, ext), lst); + } + } + return Fnreverse (lst); +} DEFUN ("load", Fload, Sload, 1, 5, 0, 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'. +then try FILE unmodified (the exact suffixes in the exact order 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. +report no error if FILE doesn't exist. Print messages at start and end of loading unless - optional third arg NOMESSAGE is non-nil. +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. +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. */) +the suffix `.elc' or `.el'; don't accept just FILE unless +it ends in one of those suffixes or includes a directory name. + +If this function fails to find a file, it may look for different +representations of that file before trying another file. +It does so by adding the non-empty suffixes in `load-file-rep-suffixes' +to the file name. Emacs uses this feature mainly to find compressed +versions of files when Auto Compression mode is enabled. + +The exact suffixes that this function tries out, in the exact order, +are given by the value of the variable `load-file-rep-suffixes' if +NOSUFFIX is non-nil and by the return value of the function +`get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and +MUST-SUFFIX are nil, this function first tries out the latter suffixes +and then the former. + +Loading a file records its definitions, and its `provide' and +`require' calls, in an element of `load-history' whose +car is the file name loaded. See `load-history'. + +Return t if the file exists and loads successfully. */) (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_INDEX (); Lisp_Object temp; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; Lisp_Object found, efound; /* 1 means we printed the ".el is newer" message. */ int newer = 0; @@ -692,7 +747,16 @@ Return t if file exists. */) 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. */ - file = Fsubstitute_in_file_name (file); + 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 */ @@ -701,7 +765,8 @@ Return t if file exists. */) int size = SBYTES (file); Lisp_Object tmp[2]; - GCPRO1 (file); + found = Qnil; + GCPRO2 (file, found); if (! NILP (must_suffix)) { @@ -720,9 +785,9 @@ Return t if file exists. */) fd = openp (Vload_path, file, (!NILP (nosuffix) ? Qnil - : !NILP (must_suffix) ? Vload_suffixes - : Fappend (2, (tmp[0] = Vload_suffixes, - tmp[1] = default_suffixes, + : !NILP (must_suffix) ? Fget_load_suffixes () + : Fappend (2, (tmp[0] = Fget_load_suffixes (), + tmp[1] = Vload_file_rep_suffixes, tmp))), &found, Qnil); UNGCPRO; @@ -731,9 +796,8 @@ Return t if file exists. */) 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; } @@ -773,8 +837,12 @@ Return t if file exists. */) if (!NILP (Fequal (found, XCAR (tem)))) count++; if (count > 3) - Fsignal (Qerror, Fcons (build_string ("Recursive load"), - Fcons (found, Vloads_in_progress))); + { + if (fd >= 0) + emacs_close (fd); + 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); } @@ -789,6 +857,8 @@ Return t if file exists. */) struct stat s1, s2; int result; + GCPRO2 (file, found); + if (!safe_to_load_p (fd)) { safe_p = 0; @@ -805,7 +875,6 @@ Return t if file exists. */) compiled = 1; - GCPRO1 (efound); efound = ENCODE_FILE (found); #ifdef DOS_NT @@ -815,7 +884,6 @@ Return t if file exists. */) 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) { @@ -825,12 +893,13 @@ Return t if file exists. */) /* 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)); + Lisp_Object msg_file; + msg_file = Fsubstring (found, make_number (0), make_number (-1)); message_with_string ("Source file `%s' newer than byte-compiled file", - file, STRING_MULTIBYTE (file)); + msg_file, 1); } } + UNGCPRO; } } else @@ -849,12 +918,12 @@ Return t if file exists. */) } } + GCPRO2 (file, found); + #ifdef WINDOWSNT emacs_close (fd); - GCPRO1 (efound); efound = ENCODE_FILE (found); stream = fopen ((char *) SDATA (efound), fmode); - UNGCPRO; #else /* not WINDOWSNT */ stream = fdopen (fd, fmode); #endif /* not WINDOWSNT */ @@ -881,18 +950,15 @@ Return t if file exists. */) message_with_string ("Loading %s...", file, 1); } - GCPRO1 (file); - lispstream = Fcons (Qnil, Qnil); - XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); - XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); - record_unwind_protect (load_unwind, lispstream); + record_unwind_protect (load_unwind, make_save_value (stream, 0)); record_unwind_protect (load_descriptor_unwind, load_descriptor_list); specbind (Qload_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); load_in_progress++; - readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil); + readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found), + Feval, 0, Qnil, Qnil, Qnil, Qnil); unbind_to (count, Qnil); /* Run any load-hooks for this file. */ @@ -925,15 +991,21 @@ Return t if file exists. */) message_with_string ("Loading %s...done", file, 1); } + if (!NILP (Fequal (build_string ("obsolete"), + Ffile_name_nondirectory + (Fdirectory_file_name (Ffile_name_directory (found)))))) + message_with_string ("Package %s is obsolete", file, 1); + return Qt; } static Lisp_Object -load_unwind (stream) /* used as unwind-protect function in load */ - Lisp_Object stream; +load_unwind (arg) /* used as unwind-protect function in load */ + Lisp_Object arg; { - fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 - | XFASTINT (XCDR (stream)))); + FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; + if (stream != NULL) + fclose (stream); if (--load_in_progress < 0) load_in_progress = 0; return Qnil; } @@ -978,6 +1050,7 @@ complete_filename_p (pathname) DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0, doc: /* Search for FILENAME through PATH. +Returns the file's name in absolute form, or nil if not found. 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'. @@ -1033,6 +1106,8 @@ openp (path, str, suffixes, storeptr, predicate) Lisp_Object string, tail, encoded_fn; int max_suffix_len = 0; + CHECK_STRING (str); + for (tail = suffixes; CONSP (tail); tail = XCDR (tail)) { CHECK_STRING_CAR (tail); @@ -1040,7 +1115,7 @@ openp (path, str, suffixes, storeptr, predicate) SBYTES (XCAR (tail))); } - string = filename = Qnil; + string = filename = encoded_fn = Qnil; GCPRO6 (str, string, filename, path, suffixes, encoded_fn); if (storeptr) @@ -1070,7 +1145,7 @@ openp (path, str, suffixes, storeptr, predicate) fn = (char *) alloca (fn_size = 100 + want_size); /* Loop over suffixes. */ - for (tail = NILP (suffixes) ? default_suffixes : suffixes; + for (tail = NILP (suffixes) ? Fcons (build_string (""), Qnil) : suffixes; CONSP (tail); tail = XCDR (tail)) { int lsuffix = SBYTES (XCAR (tail)); @@ -1105,8 +1180,8 @@ openp (path, str, suffixes, storeptr, predicate) 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); + handler = Ffind_file_name_handler (string, Qfile_exists_p); if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) { if (NILP (predicate)) @@ -1163,33 +1238,34 @@ openp (path, str, suffixes, storeptr, predicate) /* Merge the list we've accumulated of globals from the current input source into the load_history variable. The details depend on whether - the source has an associated file name or not. */ + the source has an associated file name or not. + + FILENAME is the file name that we are loading from. + ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */ static void -build_load_history (stream, source) - FILE *stream; - Lisp_Object source; +build_load_history (filename, entire) + Lisp_Object filename; + int entire; { register Lisp_Object tail, prev, newelt; register Lisp_Object tem, tem2; - register int foundit, loading; - - loading = stream || !NARROWED; + register int foundit = 0; tail = Vload_history; prev = Qnil; - foundit = 0; + while (CONSP (tail)) { tem = XCAR (tail); /* Find the feature's previous assoc list... */ - if (!NILP (Fequal (source, Fcar (tem)))) + if (!NILP (Fequal (filename, Fcar (tem)))) { foundit = 1; - /* If we're loading, remove it. */ - if (loading) + /* If we're loading the entire file, remove old data. */ + if (entire) { if (NILP (prev)) Vload_history = XCDR (tail); @@ -1221,10 +1297,10 @@ build_load_history (stream, source) QUIT; } - /* If we're loading, cons the new assoc onto the front of load-history, - the most-recently-loaded position. Also do this if we didn't find - an existing member for the current source. */ - if (loading || !foundit) + /* If we're loading an entire file, cons the new assoc onto the + front of load-history, the most-recently-loaded position. Also + do this if we didn't find an existing member for the file. */ + if (entire || !foundit) Vload_history = Fcons (Fnreverse (Vcurrent_load_list), Vload_history); } @@ -1263,65 +1339,112 @@ end_of_file_error () /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. - READFUN, if non-nil, is used instead of `read'. */ + READFUN, if non-nil, is used instead of `read'. + START, END is region in current buffer (from eval-region). */ static void -readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, readfun) +readevalloop (readcharfun, stream, sourcename, evalfun, + printflag, unibyte, readfun, start, end) Lisp_Object readcharfun; FILE *stream; Lisp_Object sourcename; Lisp_Object (*evalfun) (); int printflag; Lisp_Object unibyte, readfun; + Lisp_Object start, end; { register int c; register Lisp_Object val; int count = SPECPDL_INDEX (); - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; + int bpos; int continue_reading_p; + /* Nonzero if reading an entire buffer. */ + int whole_buffer = 0; + /* 1 on the first time around. */ + int first_sexp = 1; + + if (MARKERP (readcharfun)) + { + if (NILP (start)) + start = readcharfun; + } if (BUFFERP (readcharfun)) b = XBUFFER (readcharfun); else if (MARKERP (readcharfun)) b = XMARKER (readcharfun)->buffer; - specbind (Qstandard_input, readcharfun); + specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */ specbind (Qcurrent_load_list, Qnil); record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); load_convert_to_unibyte = !NILP (unibyte); readchar_backlog = -1; - GCPRO1 (sourcename); + GCPRO4 (sourcename, readfun, start, end); LOADHIST_ATTACH (sourcename); continue_reading_p = 1; while (continue_reading_p) { + int count1 = SPECPDL_INDEX (); + if (b != 0 && NILP (b->name)) error ("Reading from killed buffer"); + if (!NILP (start)) + { + /* Switch to the buffer we are reading from. */ + record_unwind_protect (save_excursion_restore, save_excursion_save ()); + set_buffer_internal (b); + + /* Save point in it. */ + record_unwind_protect (save_excursion_restore, save_excursion_save ()); + /* Save ZV in it. */ + record_unwind_protect (save_restriction_restore, save_restriction_save ()); + /* Those get unbound after we read one expression. */ + + /* Set point and ZV around stuff to be read. */ + Fgoto_char (start); + if (!NILP (end)) + Fnarrow_to_region (make_number (BEGV), end); + + /* Just for cleanliness, convert END to a marker + if it is an integer. */ + if (INTEGERP (end)) + end = Fpoint_max_marker (); + } + + /* On the first cycle, we can easily test here + whether we are reading the whole buffer. */ + if (b && first_sexp) + whole_buffer = (PT == BEG && ZV == Z); + instream = stream; + read_next: c = READCHAR; if (c == ';') { while ((c = READCHAR) != '\n' && c != -1); - continue; + goto read_next; + } + if (c < 0) + { + unbind_to (count1, Qnil); + break; } - if (c < 0) break; /* Ignore whitespace here, so we can detect eof. */ if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r') - continue; + goto read_next; if (!NILP (Vpurify_flag) && c == '(') { - int count1 = SPECPDL_INDEX (); record_unwind_protect (unreadpure, Qnil); val = read_list (-1, readcharfun); - unbind_to (count1, Qnil); } else { @@ -1347,6 +1470,13 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read val = read_internal_start (readcharfun, Qnil, Qnil); } + if (!NILP (start) && continue_reading_p) + start = Fpoint_marker (); + + /* Restore saved point and BEGV. */ + unbind_to (count1, Qnil); + + /* Now eval what we just read. */ val = (*evalfun) (val); if (printflag) @@ -1357,9 +1487,13 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read else Fprint (val, Qnil); } + + first_sexp = 0; } - build_load_history (stream, sourcename); + build_load_history (sourcename, + stream || whole_buffer); + UNGCPRO; unbind_to (count, Qnil); @@ -1377,7 +1511,7 @@ 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 not-nil, specifies that +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. */) @@ -1402,10 +1536,12 @@ This function preserves the position of point. */) if (NILP (filename)) filename = XBUFFER (buf)->filename; + specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); - readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil); + readevalloop (buf, 0, filename, Feval, + !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); return Qnil; @@ -1436,16 +1572,12 @@ This function does not move point. */) else tem = printflag; specbind (Qstandard_output, tem); + specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); - if (NILP (printflag)) - record_unwind_protect (save_excursion_restore, save_excursion_save ()); - record_unwind_protect (save_restriction_restore, save_restriction_save ()); - - /* This both uses start and checks its type. */ - Fgoto_char (start); - Fnarrow_to_region (make_number (BEGV), end); + /* readevalloop calls functions which check the type of start and end. */ readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, - !NILP (printflag), Qnil, read_function); + !NILP (printflag), Qnil, read_function, + start, end); return unbind_to (count, Qnil); } @@ -1534,7 +1666,7 @@ read_internal_start (stream, start, end) read_from_string_index_byte = string_char_to_byte (stream, startval); read_from_string_limit = endval; } - + retval = read0 (stream); if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, stream)) @@ -1683,7 +1815,10 @@ read_escape (readcharfun, stringp, byterep) case 's': c = READCHAR; if (c != '-') - error ("Invalid escape character syntax"); + { + UNREAD (c); + return ' '; + } c = READCHAR; if (c == '\\') c = read_escape (readcharfun, 0, byterep); @@ -1735,7 +1870,7 @@ read_escape (readcharfun, stringp, byterep) break; } } - + *byterep = 1; return i; } @@ -1809,11 +1944,11 @@ read_integer (readcharfun, radix) } else if (c == '+') c = READCHAR; - + while (c >= 0) { int digit; - + if (c >= '0' && c <= '9') digit = c - '0'; else if (c >= 'a' && c <= 'z') @@ -1878,7 +2013,7 @@ to_multibyte (p, end, nchars) if (nbytes != *nchars) nbytes = str_as_multibyte (read_buffer, read_buffer_size, *p - read_buffer, nchars); - + *p = read_buffer + nbytes; } @@ -1963,8 +2098,9 @@ read1 (readcharfun, pch, first_in_list) if (c == '"') { Lisp_Object tmp, val; - int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) - / BITS_PER_CHAR); + int size_in_chars + = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); @@ -1973,17 +2109,17 @@ read1 (readcharfun, pch, first_in_list) when the number of bits was a multiple of 8. Accept such input in case it came from an old version. */ && ! (XFASTINT (length) - == (SCHARS (tmp) - 1) * BITS_PER_CHAR)) + == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), Qnil)); - + val = Fmake_bool_vector (length, Qnil); 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) + if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) XBOOL_VECTOR (val)->data[size_in_chars - 1] - &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; + &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), @@ -2031,7 +2167,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. */ @@ -2048,7 +2184,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, @@ -2107,7 +2243,7 @@ read1 (readcharfun, pch, first_in_list) { /* #! appears at the beginning of an executable file. Skip the first line. */ - while (c != '\n') + while (c != '\n' && c >= 0) c = READCHAR; goto retry; } @@ -2154,7 +2290,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. */ @@ -2167,7 +2303,7 @@ read1 (readcharfun, pch, first_in_list) } else if (c == 'r' || c == 'R') return read_integer (readcharfun, n); - + /* Fall through to error message. */ } else if (c == 'x' || c == 'X') @@ -2231,16 +2367,50 @@ read1 (readcharfun, pch, first_in_list) case '?': { int discard; + int next_char; + int ok; c = READCHAR; 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, &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 + || (next_next_char < 0200 + && (index ("\"';([#?", next_next_char) + || (!first_in_list && next_next_char == '`') + || (new_backquote_flag && next_next_char == ',')))); + } + else + { + ok = (next_char <= 040 + || (next_char < 0200 + && (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); } @@ -2393,7 +2563,10 @@ read1 (readcharfun, pch, first_in_list) UNREAD (next_char); if (next_char <= 040 - || index ("\"'`,(", next_char)) + || (next_char < 0200 + && (index ("\"';([#?", next_char) + || (!first_in_list && next_char == '`') + || (new_backquote_flag && next_char == ',')))) { *pch = c; return Qnil; @@ -2414,9 +2587,10 @@ read1 (readcharfun, pch, first_in_list) char *end = read_buffer + read_buffer_size; while (c > 040 - && !(c == '\"' || c == '\'' || c == ';' - || c == '(' || c == ')' - || c == '[' || c == ']' || c == '#')) + && (c >= 0200 + || (!index ("\"';()[]#", c) + && !(!first_in_list && c == '`') + && !(new_backquote_flag && c == ',')))) { if (end - p < MAX_MULTIBYTE_LENGTH) { @@ -2426,7 +2600,7 @@ read1 (readcharfun, pch, first_in_list) p = read_buffer + offset; end = read_buffer + read_buffer_size; } - + if (c == '\\') { c = READCHAR; @@ -2506,6 +2680,23 @@ read1 (readcharfun, pch, first_in_list) break; case 'N': value = zero / zero; + + /* If that made a "negative" NaN, negate it. */ + + { + int i; + union { double d; char c[sizeof (double)]; } u_data, u_minus_zero; + + u_data.d = value; + u_minus_zero.d = - 0.0; + for (i = 0; i < sizeof (double); i++) + if (u_data.c[i] & u_minus_zero.c[i]) + { + value = - value; + break; + } + } + /* Now VALUE is a positive NaN. */ break; default: value = atof (read_buffer + negative); @@ -2520,7 +2711,7 @@ read1 (readcharfun, pch, first_in_list) : intern (read_buffer); if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, readcharfun)) - Vread_symbol_positions_list = + 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. */ @@ -2551,7 +2742,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; @@ -2595,7 +2786,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)) @@ -2608,7 +2799,7 @@ substitute_object_recurse (object, placeholder, subtree) { Lisp_Object idx = make_number (i); SUBSTITUTE (Faref (subtree, idx), - Faset (subtree, idx, true_value)); + Faset (subtree, idx, true_value)); } return subtree; } @@ -2629,7 +2820,7 @@ substitute_object_recurse (object, placeholder, subtree) INTERVAL root_interval = STRING_INTERVALS (subtree); Lisp_Object arg = Fcons (object, placeholder); - + traverse_intervals_noorder (root_interval, &substitute_in_interval, arg); @@ -2666,7 +2857,7 @@ isfloat_string (cp) register char *cp; { register int state; - + char *start = cp; state = 0; @@ -2756,7 +2947,7 @@ read_vector (readcharfun, bytecodeflag) if (i == COMPILED_BYTECODE) { if (!STRINGP (item)) - error ("invalid byte code"); + error ("Invalid byte code"); /* Delay handling the bytecode slot until we know whether it is lazily-loaded (we can tell by whether the @@ -2778,7 +2969,7 @@ read_vector (readcharfun, bytecodeflag) item = Fread (bytestr); if (!CONSP (item)) - error ("invalid byte code"); + error ("Invalid byte code"); otem = XCONS (item); bytestr = XCAR (item); @@ -2797,7 +2988,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. */ @@ -2816,7 +3007,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. */ @@ -3207,7 +3398,7 @@ oblookup (obarray, ptr, size, size_byte) hash %= obsize; bucket = XVECTOR (obarray)->contents[hash]; oblookup_last_bucket_number = hash; - if (XFASTINT (bucket) == 0) + if (EQ (bucket, make_number (0))) ; else if (!SYMBOLP (bucket)) error ("Bad data in guts of obarray"); /* Like CADR error message */ @@ -3305,7 +3496,7 @@ init_obarray () /* Intern nil in the obarray */ 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. */ @@ -3427,7 +3618,6 @@ defvar_per_buffer (namestring, address, type, doc) { Lisp_Object sym, val; int offset; - extern struct buffer buffer_local_symbols; sym = intern (namestring); val = allocate_misc (); @@ -3438,7 +3628,7 @@ defvar_per_buffer (namestring, address, type, doc) 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 */ @@ -3609,11 +3799,15 @@ 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 +#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON)))) + /* 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. */ + EMACSLOADPATH environment variable below, disable the warning on NT. + Also, when using the "self-contained" option for Carbon Emacs for MacOSX, + the "standard" paths may not exist and would be overridden by + EMACSLOADPATH as on NT. Since this depends on how the executable + was build and packaged, turn off the warnings in general */ /* Warn if dirs in the *standard* path don't exist. */ if (!turn_off_warning) @@ -3635,7 +3829,7 @@ init_lread () } } } -#endif /* WINDOWSNT */ +#endif /* !(WINDOWSNT || HAVE_CARBON) */ /* If the EMACSLOADPATH environment variable is set, use its value. This doesn't apply if we're dumping. */ @@ -3682,6 +3876,7 @@ syms_of_lread () defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); + defsubr (&Sget_load_suffixes); defsubr (&Sload); defsubr (&Seval_buffer); defsubr (&Seval_region); @@ -3734,7 +3929,7 @@ 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; + Vread_symbol_positions_list = Qnil; DEFVAR_LISP ("load-path", &Vload_path, doc: /* *List of directories to search for files to load. @@ -3743,13 +3938,27 @@ 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. */); + doc: /* List of suffixes for (compiled or source) Emacs Lisp files. +This list should not include the empty string. +`load' and related functions try to append these suffixes, in order, +to the specified file name if a Lisp suffix is allowed or required. */); Vload_suffixes = Fcons (build_string (".elc"), Fcons (build_string (".el"), Qnil)); + DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes, + doc: /* List of suffixes that indicate representations of \ +the same file. +This list should normally start with the empty string. + +Enabling Auto Compression mode appends the suffixes in +`jka-compr-load-suffixes' to this list and disabling Auto Compression +mode removes them again. `load' and related functions use this list to +determine whether they should look for compressed versions of a file +and, if so, which suffixes they should try to append to the file name +in order to do so. However, if you want to customize which suffixes +the loading functions recognize as compression suffixes, you should +customize `jka-compr-load-suffixes' rather than the present variable. */); /* We don't use empty_string because it's not initialized yet. */ - default_suffixes = Fcons (build_string (""), Qnil); - staticpro (&default_suffixes); + Vload_file_rep_suffixes = Fcons (build_string (""), Qnil); DEFVAR_BOOL ("load-in-progress", &load_in_progress, doc: /* Non-nil iff inside of `load'. */); @@ -3769,13 +3978,19 @@ when the corresponding call to `provide' is made. */); Vafter_load_alist = Qnil; DEFVAR_LISP ("load-history", &Vload_history, - doc: /* Alist mapping source file names to symbols and features. + doc: /* Alist mapping 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, +The remaining elements of each list are symbols defined as variables and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', -`(defvar . VARIABLE), and `(autoload . SYMBOL)'. */); +`(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'. +An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)', +and means that SYMBOL was an autoload before this file redefined it +as a function. + +During preloading, the file name recorded is relative to the main Lisp +directory. These file names are converted to absolute at startup. */); Vload_history = Qnil; DEFVAR_LISP ("load-file-name", &Vload_file_name, @@ -3784,8 +3999,8 @@ and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', DEFVAR_LISP ("user-init-file", &Vuser_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 +If the file loaded had extension `.elc', and the corresponding source file +exists, this variable contains the name of source file, suitable for use by functions like `custom-save-all' which edit the init file. */); Vuser_init_file = Qnil; @@ -3849,6 +4064,10 @@ to load. See also `load-dangerous-libraries'. */); Vbytecomp_version_regexp = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); + DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list, + doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); + Veval_buffer_list = Qnil; + /* Vsource_directory was initialized in init_lread. */ load_descriptor_list = Qnil; @@ -3890,12 +4109,19 @@ to load. See also `load-dangerous-libraries'. */); Qload_file_name = intern ("load-file-name"); staticpro (&Qload_file_name); + Qeval_buffer_list = intern ("eval-buffer-list"); + staticpro (&Qeval_buffer_list); + staticpro (&dump_path); staticpro (&read_objects); read_objects = Qnil; staticpro (&seen_list); - + seen_list = Qnil; + Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); } + +/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d + (do not change this comment) */