X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/714d8c393b62d807603e74e553e254ede8f18d39..204b78de1b66429250e18785a65392b5027ef103:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 81ae1f27a5..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 @@ -34,6 +35,7 @@ Boston, MA 02111-1307, USA. */ #include "commands.h" #include "keyboard.h" #include "termhooks.h" +#include "coding.h" #ifdef lint #include @@ -60,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 @@ -81,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; @@ -132,6 +138,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; @@ -149,6 +162,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; @@ -190,8 +206,9 @@ int load_dangerous_libraries; static Lisp_Object Vbytecomp_version_regexp; static void to_multibyte P_ ((char **, char **, int *)); -static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, +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)); @@ -201,8 +218,14 @@ static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); 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) @@ -215,6 +238,8 @@ readchar (readcharfun) Lisp_Object tem; register int c; + readchar_count++; + if (BUFFERP (readcharfun)) { register struct buffer *inbuffer = XBUFFER (readcharfun); @@ -300,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); } @@ -334,6 +360,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. */ @@ -388,10 +415,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. */ @@ -427,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. */ @@ -468,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)) { @@ -607,33 +644,82 @@ 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. 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_ptr - specpdl; + int count = SPECPDL_INDEX (); Lisp_Object temp; - struct gcpro gcpro1; - Lisp_Object found; + struct gcpro gcpro1, gcpro2; + Lisp_Object found, efound; /* 1 means we printed the ".el is newer" message. */ int newer = 0; /* 1 means we are loading a compiled file. */ @@ -661,25 +747,35 @@ 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 */ - 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); + found = Qnil; + GCPRO2 (file, found); if (! NILP (must_suffix)) { /* 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. */ @@ -689,20 +785,19 @@ 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, 0); + &found, Qnil); UNGCPRO; } 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; } @@ -742,13 +837,17 @@ 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); } - if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]), + if (!bcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)) /* Load .elc files directly, but not when they are remote and have no handler! */ @@ -758,26 +857,34 @@ Return t if file exists. */) struct stat s1, s2; int result; + GCPRO2 (file, found); + if (!safe_to_load_p (fd)) { safe_p = 0; if (!load_dangerous_libraries) - error ("File `%s' was not compiled in Emacs", - XSTRING (found)->data); + { + 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; + efound = ENCODE_FILE (found); + #ifdef DOS_NT 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); - XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 1] = 'c'; - + stat ((char *)SDATA (efound), &s1); + SSET (efound, SBYTES (efound) - 1, 0); + result = stat ((char *)SDATA (efound), &s2); + SSET (efound, SBYTES (efound) - 1, 'c'); + if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) { /* Make the progress messages mention that source is newer. */ @@ -786,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, SMBP (file)); + msg_file, 1); } } + UNGCPRO; } } else @@ -810,16 +918,19 @@ Return t if file exists. */) } } + GCPRO2 (file, found); + #ifdef WINDOWSNT emacs_close (fd); - stream = fopen ((char *) XSTRING (found)->data, fmode); + efound = ENCODE_FILE (found); + stream = fopen ((char *) SDATA (efound), fmode); #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)) @@ -839,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. */ @@ -883,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; } @@ -921,9 +1035,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 == '@' @@ -934,6 +1048,25 @@ 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'. +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. On success, returns a file descriptor. On failure, returns -1. @@ -941,24 +1074,25 @@ complete_filename_p (pathname) SUFFIXES is a list of strings containing possible suffixes. The empty suffix is automatically added iff the list is empty. - EXEC_ONLY nonzero means don't open the files, - just look for one that is executable. In this case, - returns 1 on success. + 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 -2 - but store the found remote file name in *STOREPTR. - We do not check for remote files if EXEC_ONLY is nonzero. */ + but store the found remote file name in *STOREPTR. */ int -openp (path, str, suffixes, storeptr, exec_only) +openp (path, str, suffixes, storeptr, predicate) Lisp_Object path, str; Lisp_Object suffixes; Lisp_Object *storeptr; - int exec_only; + Lisp_Object predicate; { register int fd; int fn_size = 100; @@ -968,20 +1102,22 @@ openp (path, str, suffixes, storeptr, exec_only) int want_size; Lisp_Object filename; struct stat st; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - Lisp_Object string, tail; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; + 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); max_suffix_len = max (max_suffix_len, - STRING_BYTES (XSTRING (XCAR (tail)))); + SBYTES (XCAR (tail))); } - string = filename = Qnil; - GCPRO5 (str, string, filename, path, suffixes); - + string = filename = encoded_fn = Qnil; + GCPRO6 (str, string, filename, path, suffixes, encoded_fn); + if (storeptr) *storeptr = Qnil; @@ -1004,37 +1140,38 @@ openp (path, str, suffixes, storeptr, exec_only) /* Calculate maximum size of any filename made from this path element/specified file name and any possible suffix. */ - want_size = max_suffix_len + 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); /* 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 = STRING_BYTES (XSTRING (XCAR (tail))); + 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, XSTRING (XCAR (tail))->data, lsuffix); - + strncat (fn, SDATA (XCAR (tail)), lsuffix); + /* Check that the file exists and is not a directory. */ /* We used to only check for handlers on non-absolute file names: if (absolute) @@ -1043,42 +1180,47 @@ openp (path, str, suffixes, storeptr, exec_only) 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); - if (!NILP (handler) && !exec_only) - { - int exists; - - string = build_string (fn); - exists = !NILP (Ffile_readable_p (string)); - if (exists && !NILP (Ffile_directory_p (build_string (fn)))) + string = build_string (fn); + handler = Ffind_file_name_handler (string, Qfile_exists_p); + 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 -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; } @@ -1096,38 +1238,39 @@ openp (path, str, suffixes, storeptr, exec_only) /* 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 (!NILP (tail)) + + while (CONSP (tail)) { - tem = Fcar (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 = 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. */ @@ -1137,27 +1280,27 @@ 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; } - /* 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); } @@ -1196,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_ptr - specpdl; - struct gcpro gcpro1; + int count = SPECPDL_INDEX (); + 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_ptr - specpdl; record_unwind_protect (unreadpure, Qnil); val = read_list (-1, readcharfun); - unbind_to (count1, Qnil); } else { @@ -1277,9 +1467,16 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read else if (! NILP (Vload_read_function)) val = call1 (Vload_read_function, readcharfun); else - val = read0 (readcharfun); + 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) @@ -1290,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); @@ -1310,14 +1511,14 @@ 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. */) (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)) @@ -1335,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; @@ -1359,7 +1562,7 @@ 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 (); @@ -1369,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); } @@ -1398,24 +1597,14 @@ STREAM or the value of `standard-input' may be: (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, @@ -1426,40 +1615,63 @@ START and END optionally delimit a substring of STRING from which to read; (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)); +} - if (NILP (end)) - endval = XSTRING (string)->size; - else - { - CHECK_NUMBER (end); - endval = XINT (end); - if (endval < 0 || endval > XSTRING (string)->size) - args_out_of_range (string, end); - } - - if (NILP (start)) - startval = 0; - else - { - CHECK_NUMBER (start); - 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; +/* 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; + 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 (STRINGP (stream)) + { + 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); + } - tem = read0 (string); - return Fcons (tem, make_number (read_from_string_index)); + 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; + } + + 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 @@ -1499,10 +1711,16 @@ read_multibyte (c, readcharfun) 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); if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes)) return STRING_CHAR (str, len); @@ -1597,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); @@ -1649,7 +1870,7 @@ read_escape (readcharfun, stringp, byterep) break; } } - + *byterep = 1; return i; } @@ -1723,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') @@ -1792,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; } @@ -1877,27 +2098,28 @@ 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); - 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) * BOOL_VECTOR_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) + 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), @@ -1945,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. */ @@ -1962,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, @@ -2017,6 +2239,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 >= 0) + c = READCHAR; + goto retry; + } if (c == '$') return Vload_file_name; if (c == '\'') @@ -2060,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. */ @@ -2073,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') @@ -2137,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); } @@ -2281,6 +2545,11 @@ read1 (readcharfun, pch, first_in_list) separate characters, treat them as separate characters now. */ ; + /* 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, is_multibyte); @@ -2294,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; @@ -2315,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) { @@ -2327,7 +2600,7 @@ read1 (readcharfun, pch, first_in_list) p = read_buffer + offset; end = read_buffer + read_buffer_size; } - + if (c == '\\') { c = READCHAR; @@ -2407,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); @@ -2416,11 +2706,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; + } } } } @@ -2442,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; @@ -2486,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)) @@ -2499,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; } @@ -2518,9 +2818,9 @@ substitute_object_recurse (object, placeholder, subtree) /* Check for text properties in each interval. 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_noorder (root_interval, &substitute_in_interval, arg); @@ -2557,7 +2857,7 @@ isfloat_string (cp) register char *cp; { register int state; - + char *start = cp; state = 0; @@ -2647,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 @@ -2664,12 +2964,12 @@ 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)) - error ("invalid byte code"); + error ("Invalid byte code"); otem = XCONS (item); bytestr = XCAR (item); @@ -2688,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. */ @@ -2707,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. */ @@ -2877,7 +3177,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. */ @@ -2901,7 +3200,7 @@ check_obarray (obarray) Lisp_Object intern (str) - char *str; + const char *str; { Lisp_Object tem; int len = strlen (str); @@ -2944,9 +3243,9 @@ it defaults to the value of `obarray'. */) 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; @@ -2959,7 +3258,7 @@ it defaults to the value of `obarray'. */) else XSYMBOL (sym)->interned = SYMBOL_INTERNED; - if ((XSTRING (string)->data[0] == ':') + if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) { XSYMBOL (sym)->constant = 1; @@ -2984,8 +3283,7 @@ 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); @@ -2993,12 +3291,12 @@ it defaults to the value of `obarray'. */) if (!SYMBOLP (name)) { CHECK_STRING (name); - string = XSTRING (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 @@ -3021,16 +3319,16 @@ 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); 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. */ @@ -3079,7 +3377,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; @@ -3100,16 +3398,16 @@ 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 */ 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; @@ -3120,11 +3418,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; @@ -3198,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. */ @@ -3320,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 (); @@ -3331,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 */ @@ -3502,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) @@ -3522,13 +3823,13 @@ 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)); } } } -#endif /* WINDOWSNT */ +#endif /* !(WINDOWSNT || HAVE_CARBON) */ /* If the EMACSLOADPATH environment variable is set, use its value. This doesn't apply if we're dumping. */ @@ -3558,10 +3859,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)); @@ -3575,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); @@ -3583,6 +3885,7 @@ syms_of_lread () defsubr (&Sread_event); defsubr (&Sget_file_char); defsubr (&Smapatoms); + defsubr (&Slocate_file_internal); DEFVAR_LISP ("obarray", &Vobarray, doc: /* Symbol table for use by `intern' and `read'. @@ -3599,6 +3902,35 @@ Order is reverse chronological. */); 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, doc: /* *List of directories to search for files to load. Each element is a string (directory name) or nil (try default directory). @@ -3606,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'. */); @@ -3632,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 -or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)', -and `(autoload . SYMBOL)'. */); +The remaining elements of each list are symbols defined as variables +and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', +`(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, @@ -3647,8 +3999,8 @@ and `(autoload . SYMBOL)'. */); 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; @@ -3712,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; @@ -3753,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) */