X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d6567030a2d3c336a031bc97eea4af2df95f3d61..9f14330b7bd7166616c72898e1f33fd556266b1c:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 5dc3cc9346..6d082203fe 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,6 +1,6 @@ /* 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, 2003, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -61,6 +61,9 @@ Boston, MA 02111-1307, USA. */ #include #endif /* HAVE_SETLOCALE */ +#ifdef HAVE_FCNTL_H +#include +#endif #ifndef O_RDONLY #define O_RDONLY 0 #endif @@ -215,7 +218,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 +236,7 @@ readchar (readcharfun) register int c; readchar_count++; - + if (BUFFERP (readcharfun)) { register struct buffer *inbuffer = XBUFFER (readcharfun); @@ -319,6 +322,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 +415,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 +461,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 +502,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,6 +641,14 @@ 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 ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. @@ -692,7 +704,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 */ @@ -731,9 +752,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; } @@ -793,8 +813,12 @@ Return t if file exists. */) { safe_p = 0; if (!load_dangerous_libraries) - error ("File `%s' was not compiled in Emacs", - SDATA (found)); + { + 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); } @@ -824,7 +848,7 @@ Return t if file exists. */) Lisp_Object file; file = Fsubstring (found, make_number (0), make_number (-1)); message_with_string ("Source file `%s' newer than byte-compiled file", - file, STRING_MULTIBYTE (file)); + file, 1); } } } @@ -921,6 +945,11 @@ 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; } @@ -1029,6 +1058,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); @@ -1101,8 +1132,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)) @@ -1373,7 +1404,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. */) @@ -1530,7 +1561,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)) @@ -1677,9 +1708,13 @@ read_escape (readcharfun, stringp, 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, byterep); @@ -1731,7 +1766,7 @@ read_escape (readcharfun, stringp, byterep) break; } } - + *byterep = 1; return i; } @@ -1805,11 +1840,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') @@ -1874,7 +1909,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; } @@ -1959,8 +1994,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); @@ -1969,17 +2005,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), @@ -2027,7 +2063,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. */ @@ -2044,7 +2080,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, @@ -2103,7 +2139,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; } @@ -2150,7 +2186,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. */ @@ -2163,7 +2199,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') @@ -2227,16 +2263,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); } @@ -2389,7 +2459,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; @@ -2410,9 +2483,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) { @@ -2422,7 +2496,7 @@ read1 (readcharfun, pch, first_in_list) p = read_buffer + offset; end = read_buffer + read_buffer_size; } - + if (c == '\\') { c = READCHAR; @@ -2516,7 +2590,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. */ @@ -2547,7 +2621,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; @@ -2591,7 +2665,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)) @@ -2604,7 +2678,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; } @@ -2625,7 +2699,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); @@ -2662,7 +2736,7 @@ isfloat_string (cp) register char *cp; { register int state; - + char *start = cp; state = 0; @@ -2793,7 +2867,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. */ @@ -2812,7 +2886,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. */ @@ -3203,7 +3277,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 */ @@ -3301,7 +3375,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. */ @@ -3423,7 +3497,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 (); @@ -3434,7 +3507,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 */ @@ -3605,11 +3678,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) @@ -3631,7 +3708,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. */ @@ -3730,7 +3807,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. @@ -3769,9 +3846,12 @@ when the corresponding call to `provide' is made. */); 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. */); Vload_history = Qnil; DEFVAR_LISP ("load-file-name", &Vload_file_name, @@ -3891,7 +3971,10 @@ to load. See also `load-dangerous-libraries'. */); staticpro (&read_objects); read_objects = Qnil; staticpro (&seen_list); - + Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); } + +/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d + (do not change this comment) */