/* Lisp parsing and input streams.
-Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation,
+Copyright (C) 1985-1989, 1993-1995, 1997-2016 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include "character.h"
#include "buffer.h"
#include "charset.h"
-#include "coding.h"
#include <epaths.h>
#include "commands.h"
#include "keyboard.h"
#include "systime.h"
#include "termhooks.h"
#include "blockinput.h"
+#include <c-ctype.h>
#ifdef MSDOS
#include "msdos.h"
+#if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
+# define INFINITY __builtin_inf()
+# define NAN __builtin_nan("")
+#endif
#endif
#ifdef HAVE_NS
return c;
}
- if (CONSP (readcharfun))
+ if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
{
/* This is the case that read_vector is reading from a unibyte
string that contains a byte sequence previously skipped
read_from_string_index_byte
= string_char_to_byte (readcharfun, read_from_string_index);
}
- else if (CONSP (readcharfun))
+ else if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
{
unread_char = c;
}
return Fnreverse (lst);
}
+/* Returns true if STRING ends with SUFFIX */
+static bool
+suffix_p (Lisp_Object string, const char *suffix)
+{
+ ptrdiff_t suffix_len = strlen (suffix);
+ ptrdiff_t string_len = SBYTES (string);
+
+ return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
+}
+
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',
+First try FILE with `.elc' appended, then try with `.el', then try
+with a system-dependent suffix of dynamic modules (see `load-suffixes'),
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'.
optional third arg NOMESSAGE is non-nil (but `force-load-messages'
overrides that).
If optional fourth arg NOSUFFIX is non-nil, don't try adding
-suffixes `.elc' or `.el' to the specified name FILE.
+suffixes 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.
+the suffix `.elc' or `.el' or the module suffix; don't accept just
+FILE unless it ends in one of those suffixes or includes a directory name.
If NOSUFFIX is nil, then if a file could not be found, try looking for
a different representation of the file by adding non-empty suffixes to
{
FILE *stream;
int fd;
- int fd_index;
+ int fd_index UNINIT;
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object found, efound, hist_file_name;
/* True means we printed the ".el is newer" message. */
if (! NILP (must_suffix))
{
/* Don't insist on adding a suffix if FILE already ends with one. */
- ptrdiff_t size = SBYTES (file);
- if (size > 3
- && !strcmp (SSDATA (file) + size - 3, ".el"))
- must_suffix = Qnil;
- else if (size > 4
- && !strcmp (SSDATA (file) + size - 4, ".elc"))
+ if (suffix_p (file, ".el")
+ || suffix_p (file, ".elc")
+#ifdef HAVE_MODULES
+ || suffix_p (file, MODULES_SUFFIX)
+#endif
+ )
must_suffix = Qnil;
/* Don't insist on adding a suffix
if the argument includes a directory name. */
#endif
}
- if (fd < 0)
- {
- /* Pacify older GCC with --enable-gcc-warnings. */
- IF_LINT (fd_index = 0);
- }
- else
+ if (0 <= fd)
{
fd_index = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
}
+#ifdef HAVE_MODULES
+ if (suffix_p (found, MODULES_SUFFIX))
+ return unbind_to (count, Fmodule_load (found));
+#endif
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
- if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
- || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
+ int is_elc;
+ if ((is_elc = suffix_p (found, ".elc")) != 0
+ /* version = 1 means the file is empty, in which case we can
+ treat it as not byte-compiled. */
+ || (fd >= 0 && (version = safe_to_load_version (fd)) > 1))
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
/* openp already checked for newness, no point doing it again.
FIXME would be nice to get a message when openp
ignores suffix order due to load_prefer_newer. */
- if (!load_prefer_newer)
+ if (!load_prefer_newer && is_elc)
{
result = stat (SSDATA (efound), &s1);
if (result == 0)
for (; CONSP (path); path = XCDR (path))
{
+ ptrdiff_t baselen, prefixlen;
+
filename = Fexpand_file_name (str, XCAR (path));
if (!complete_filename_p (filename))
/* If there are non-absolute elts in PATH (eg "."). */
fn = SAFE_ALLOCA (fn_size);
}
+ /* Copy FILENAME's data to FN but remove starting /: if any. */
+ prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
+ ? 2 : 0);
+ baselen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, baselen);
+
/* Loop over suffixes. */
for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
CONSP (tail); tail = XCDR (tail))
ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
Lisp_Object handler;
- /* Concatenate path element/specified name with the suffix.
- If the directory starts with /:, remove that. */
- int prefixlen = ((SCHARS (filename) > 2
- && SREF (filename, 0) == '/'
- && SREF (filename, 1) == ':')
- ? 2 : 0);
- fnlen = SBYTES (filename) - prefixlen;
- memcpy (fn, SDATA (filename) + prefixlen, fnlen);
- memcpy (fn + fnlen, SDATA (suffix), lsuffix + 1);
- fnlen += lsuffix;
+ /* Make complete filename by appending SUFFIX. */
+ memcpy (fn + baselen, SDATA (suffix), lsuffix + 1);
+ fnlen = baselen + 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)
}
else
{
- int oflags = O_RDONLY + (NILP (predicate) ? 0 : O_BINARY);
- fd = emacs_open (pfn, oflags, 0);
+ fd = emacs_open (pfn, O_RDONLY, 0);
if (fd < 0)
{
if (errno != ENOENT)
}
DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
- doc: /* Execute the current buffer as Lisp code.
+ doc: /* Execute the accessible portion of current buffer as Lisp code.
+You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
When called from a Lisp program (i.e., not interactively), this
function accepts up to five optional arguments:
-BUFFER is the buffer to evaluate (nil means use current buffer).
-PRINTFLAG controls printing of output:
- A value of nil means discard it; anything else is stream for print.
+BUFFER is the buffer to evaluate (nil means use current buffer),
+ or a name of a buffer (a string).
+PRINTFLAG controls printing of output by any output functions in the
+ evaluated code, such as `print', `princ', and `prin1':
+ a value of nil means discard it; anything else is the stream to print to.
+ See Info node `(elisp)Output Streams' for details on streams.
FILENAME specifies the file name to use for `load-history'.
UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
invocation.
-DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
- functions should work normally even if PRINTFLAG is nil.
+DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
+ evaluated code should work normally even if PRINTFLAG is nil, in
+ which case the output is displayed in the echo area.
This function preserves the position of point. */)
(Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
giving starting and ending indices in the current buffer
of the text to be executed.
Programs can pass third argument PRINTFLAG which controls output:
-A value of nil means discard it; anything else is stream for printing it.
+ a value of nil means discard it; anything else is stream for printing it.
+ See Info node `(elisp)Output Streams' for details on streams.
Also the fourth argument READ-FUNCTION, if non-nil, is used
instead of `read' to read each expression. It gets one argument
which is the input stream for reading characters.
FINAL-STRING-INDEX is an integer giving the position of the next
remaining character in STRING. START and END optionally delimit
a substring of STRING from which to read; they default to 0 and
-(length STRING) respectively. Negative values are counted from
+\(length STRING) respectively. Negative values are counted from
the end of STRING. */)
(Lisp_Object string, Lisp_Object start, Lisp_Object end)
{
static ptrdiff_t read_buffer_size;
static char *read_buffer;
+/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
+
+static void
+grow_read_buffer (void)
+{
+ read_buffer = xpalloc (read_buffer, &read_buffer_size,
+ MAX_MULTIBYTE_LENGTH, -1, 1);
+}
+
+/* Return the scalar value that has the Unicode character name NAME.
+ Raise 'invalid-read-syntax' if there is no such character. */
+static int
+character_name_to_code (char const *name, ptrdiff_t name_len)
+{
+ /* For "U+XXXX", pass the leading '+' to string_to_number to reject
+ monstrosities like "U+-0000". */
+ Lisp_Object code
+ = (name[0] == 'U' && name[1] == '+'
+ ? string_to_number (name + 1, 16, false)
+ : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt));
+
+ if (! RANGED_INTEGERP (0, code, MAX_UNICODE_CHAR)
+ || char_surrogate_p (XINT (code)))
+ {
+ AUTO_STRING (format, "\\N{%s}");
+ AUTO_STRING_WITH_LEN (namestr, name, name_len);
+ xsignal1 (Qinvalid_read_syntax, CALLN (Fformat, format, namestr));
+ }
+
+ return XINT (code);
+}
+
+/* Bound on the length of a Unicode character name. As of
+ Unicode 9.0.0 the maximum is 83, so this should be safe. */
+enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 };
+
/* Read a \-escape sequence, assuming we already read the `\'.
If the escape sequence forces unibyte, return eight-bit char. */
return i;
}
+ case 'N':
+ /* Named character. */
+ {
+ c = READCHAR;
+ if (c != '{')
+ invalid_syntax ("Expected opening brace after \\N");
+ char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
+ bool whitespace = false;
+ ptrdiff_t length = 0;
+ while (true)
+ {
+ c = READCHAR;
+ if (c < 0)
+ end_of_file_error ();
+ if (c == '}')
+ break;
+ if (! (0 < c && c < 0x80))
+ {
+ AUTO_STRING (format,
+ "Invalid character U+%04X in character name");
+ xsignal1 (Qinvalid_read_syntax,
+ CALLN (Fformat, format, make_natnum (c)));
+ }
+ /* Treat multiple adjacent whitespace characters as a
+ single space character. This makes it easier to use
+ character names in e.g. multi-line strings. */
+ if (c_isspace (c))
+ {
+ if (whitespace)
+ continue;
+ c = ' ';
+ whitespace = true;
+ }
+ else
+ whitespace = false;
+ name[length++] = c;
+ if (length >= sizeof name)
+ invalid_syntax ("Character name too long");
+ }
+ if (length == 0)
+ invalid_syntax ("Empty character name");
+ name[length] = '\0';
+ return character_name_to_code (name, length);
+ }
+
default:
return c;
}
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
if (p == end)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
Lisp_Object
check_obarray (Lisp_Object obarray)
{
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
+ /* We don't want to signal a wrong-type-argument error when we are
+ shutting down due to a fatal error, and we don't want to hit
+ assertions in VECTORP and ASIZE if the fatal error was during GC. */
+ if (!fatal_error_in_progress
+ && (!VECTORP (obarray) || ASIZE (obarray) == 0))
{
/* If Vobarray is now invalid, force it to be valid. */
if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
Lisp_Object bucket, tem;
obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
-
/* This is sometimes needed in the middle of GC. */
- obsize &= ~ARRAY_MARK_FLAG;
+ obsize = gc_asize (obarray);
hash = hash_string (ptr, size_byte) % obsize;
bucket = AREF (obarray, hash);
oblookup_last_bucket_number = hash;
load_path_check (default_lpath);
/* Add the site-lisp directories to the front of the default. */
- if (!no_site_lisp)
+ if (!no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
{
Lisp_Object sitelisp;
sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
load_path_check (Vload_path);
/* Add the site-lisp directories at the front. */
- if (initialized && !no_site_lisp)
+ if (initialized && !no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
{
Lisp_Object sitelisp;
sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
dir_warning (char const *use, Lisp_Object dirname)
{
static char const format[] = "Warning: %s '%s': %s\n";
- int access_errno = errno;
- fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)),
- strerror (access_errno));
+ char *diagnostic = emacs_strerror (errno);
+ fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)), diagnostic);
/* Don't log the warning before we've initialized!! */
if (initialized)
{
- char const *diagnostic = emacs_strerror (access_errno);
+ ptrdiff_t diaglen = strlen (diagnostic);
+ AUTO_STRING_WITH_LEN (diag, diagnostic, diaglen);
+ if (! NILP (Vlocale_coding_system))
+ {
+ Lisp_Object s
+ = code_convert_string_norecord (diag, Vlocale_coding_system, false);
+ diagnostic = SSDATA (s);
+ diaglen = SBYTES (s);
+ }
USE_SAFE_ALLOCA;
char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
- + strlen (use) + SBYTES (dirname)
- + strlen (diagnostic));
+ + strlen (use) + SBYTES (dirname) + diaglen);
ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
diagnostic);
message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed.
- Order is reverse chronological. */);
+Order is reverse chronological. */);
XSYMBOL (intern ("values"))->declared_special = 0;
DEFVAR_LISP ("standard-input", Vstandard_input,
DEFVAR_LISP ("load-path", Vload_path,
doc: /* List of directories to search for files to load.
Each element is a string (directory file name) or nil (meaning
-`default-directory'). Initialized during startup as described in Info
-node `(elisp)Library Search'. Use `directory-file-name' when adding items
-to this path. */);
+`default-directory').
+This list is consulted by the `require' function.
+Initialized during startup as described in Info node `(elisp)Library Search'.
+Use `directory-file-name' when adding items to this path. However, Lisp
+programs that process this list should tolerate directories both with
+and without trailing slashes. */);
DEFVAR_LISP ("load-suffixes", Vload_suffixes,
- doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
+ doc: /* List of suffixes for Emacs Lisp files and dynamic modules.
+This list includes suffixes for both compiled and 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. */);
+to the specified file name if a suffix is allowed or required. */);
+#ifdef HAVE_MODULES
+ Vload_suffixes = list3 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"),
+ build_pure_c_string (MODULES_SUFFIX));
+#else
Vload_suffixes = list2 (build_pure_c_string (".elc"),
build_pure_c_string (".el"));
+#endif
+ DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
+ doc: /* Suffix of loadable module file, or nil of modules are not supported. */);
+#ifdef HAVE_MODULES
+ Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
+#else
+ Vmodule_file_suffix = Qnil;
+#endif
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
DEFSYM (Qweakness, "weakness");
DEFSYM (Qrehash_size, "rehash-size");
DEFSYM (Qrehash_threshold, "rehash-threshold");
+
+ DEFSYM (Qchar_from_name, "char-from-name");
}