/* 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 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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 <config.h>
#include <locale.h>
#endif /* HAVE_SETLOCALE */
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
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. */
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));
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?
register int c;
readchar_count++;
-
+
if (BUFFERP (readcharfun))
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
/* Interrupted reads have been observed while reading over the network */
while (c == EOF && ferror (instream) && errno == EINTR)
{
+ QUIT;
clearerr (instream);
c = getc (instream);
}
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));
if (display_hourglass_p)
cancel_hourglass ();
#endif
-
+
delayed_switch_frame = Qnil;
/* Read until we get an acceptable event. */
XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
}
}
-
+
/* If we don't have a character now, deal with it appropriately. */
if (!INTEGERP (val))
{
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.
First try FILE with `.elc' appended, then try with `.el',
- then try FILE unmodified. Environment variable references in FILE
+ then try FILE unmodified (the exact suffixes are determined by
+`load-suffixes'). Environment variable references in FILE
are replaced with their values by calling `substitute-in-file-name'.
This function searches the directories in `load-path'.
If optional second arg NOERROR is non-nil,
{
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, efound;
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);
{
/* 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. */
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;
}
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! */
{
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);
}
#ifdef DOS_NT
fmode = "rb";
#endif /* DOS_NT */
- stat ((char *)XSTRING (efound)->data, &s1);
- XSTRING (efound)->data[STRING_BYTES (XSTRING (efound)) - 1] = 0;
- result = stat ((char *)XSTRING (efound)->data, &s2);
- XSTRING (efound)->data[STRING_BYTES (XSTRING (efound)) - 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');
UNGCPRO;
if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
Lisp_Object file;
file = Fsubstring (found, make_number (0), make_number (-1));
message_with_string ("Source file `%s' newer than byte-compiled file",
- file, SMBP (file));
+ file, 1);
}
}
}
emacs_close (fd);
GCPRO1 (efound);
efound = ENCODE_FILE (found);
- stream = fopen ((char *) XSTRING (efound)->data, fmode);
+ stream = fopen ((char *) SDATA (efound), fmode);
UNGCPRO;
#else /* not WINDOWSNT */
stream = fdopen (fd, fmode);
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))
}
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, file, Feval,
+ 0, Qnil, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
/* Run any load-hooks for this file. */
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;
}
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 == '@'
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'.
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;
/* 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);
for (tail = NILP (suffixes) ? default_suffixes : 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:
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))
}
else
{
- char *pfn;
+ const char *pfn;
encoded_fn = ENCODE_FILE (string);
- pfn = XSTRING (encoded_fn)->data;
+ pfn = SDATA (encoded_fn);
exists = (stat (pfn, &st) >= 0
&& (st.st_mode & S_IFMT) != S_IFDIR);
if (exists)
{
newelt = XCAR (tem2);
- if (NILP (Fmemq (newelt, tem)))
+ if (NILP (Fmember (newelt, tem)))
Fsetcar (tail, Fcons (XCAR (tem),
Fcons (newelt, XCDR (tem))));
/* 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;
+ int count = SPECPDL_INDEX ();
struct gcpro gcpro1;
struct buffer *b = 0;
int continue_reading_p;
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))
+ {
+ record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+ Fgoto_char (start);
+ Fnarrow_to_region (make_number (BEGV), end);
+ }
+
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
{
val = read_internal_start (readcharfun, Qnil, Qnil);
}
+ if (!NILP (start) && continue_reading_p)
+ start = Fpoint_marker ();
+ unbind_to (count1, Qnil);
+
val = (*evalfun) (val);
if (printflag)
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))
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;
(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 ();
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);
}
(stream)
Lisp_Object stream;
{
- extern Lisp_Object Fread_minibuffer ();
- Lisp_Object tem;
if (NILP (stream))
stream = Vstandard_input;
if (EQ (stream, Qt))
(string, start, end)
Lisp_Object string, start, end;
{
+ Lisp_Object ret;
CHECK_STRING (string);
- return Fcons (read_internal_start (string, start, end),
- make_number (read_from_string_index));
+ /* read_internal_start sets read_from_string_index. */
+ ret = read_internal_start (string, start, end);
+ return Fcons (ret, make_number (read_from_string_index));
}
/* Function to set up the global context we need in toplevel read
{
int startval, endval;
if (NILP (end))
- endval = XSTRING (stream)->size;
+ endval = SCHARS (stream);
else
{
CHECK_NUMBER (end);
endval = XINT (end);
- if (endval < 0 || endval > XSTRING (stream)->size)
+ if (endval < 0 || endval > SCHARS (stream))
args_out_of_range (stream, 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))
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);
break;
}
}
-
+
*byterep = 1;
return i;
}
}
else if (c == '+')
c = READCHAR;
-
+
while (c >= 0)
{
int digit;
-
+
if (c >= '0' && c <= '9')
digit = c - '0';
else if (c >= 'a' && c <= 'z')
if (nbytes != *nchars)
nbytes = str_as_multibyte (read_buffer, read_buffer_size,
*p - read_buffer, nchars);
-
+
*p = read_buffer + nbytes;
}
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),
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. */
}
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,
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 == '\'')
/* ...and #n# will use the real value from now on. */
Fsetcdr (cell, tem);
-
+
return tem;
}
/* #n# returns a previously read object. */
}
else if (c == 'r' || c == 'R')
return read_integer (readcharfun, n);
-
+
/* Fall through to error message. */
}
else if (c == 'x' || c == 'X')
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);
}
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;
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)
{
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
-
+
if (c == '\\')
{
c = READCHAR;
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);
: 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. */
- Fcons (Fcons (result, readchar_count - Flength (Fsymbol_name (result))),
+ Fcons (Fcons (result,
+ make_number (readchar_count
+ - XFASTINT (Flength (Fsymbol_name (result))))),
Vread_symbol_positions_list);
return result;
}
/* Make all the substitutions. */
check_object
= substitute_object_recurse (object, placeholder, object);
-
+
/* Clear seen_list because we're done with it. */
seen_list = Qnil;
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))
{
Lisp_Object idx = make_number (i);
SUBSTITUTE (Faref (subtree, idx),
- Faset (subtree, idx, true_value));
+ Faset (subtree, idx, true_value));
}
return 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);
register char *cp;
{
register int state;
-
+
char *start = cp;
state = 0;
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
/* 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);
}
return vector;
}
-
+
/* FLAG = 1 means check for ] to terminate rather than ) and .
FLAG = -1 means check for starting with defun
and make structure pure. */
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. */
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. */
Lisp_Object
intern (str)
- char *str;
+ const char *str;
{
Lisp_Object tem;
int len = strlen (str);
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;
else
XSYMBOL (sym)->interned = SYMBOL_INTERNED;
- if ((XSTRING (string)->data[0] == ':')
+ if ((SREF (string, 0) == ':')
&& EQ (obarray, initial_obarray))
{
XSYMBOL (sym)->constant = 1;
(name, obarray)
Lisp_Object name, obarray;
{
- register Lisp_Object tem;
- struct Lisp_String *string;
+ register Lisp_Object tem, string;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
if (!SYMBOLP (name))
{
CHECK_STRING (name);
- string = XSTRING (name);
+ string = name;
}
else
- string = XSTRING (SYMBOL_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
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. */
Lisp_Object
oblookup (obarray, ptr, size, size_byte)
Lisp_Object obarray;
- register char *ptr;
+ register const char *ptr;
int size, size_byte;
{
int hash;
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 (XSTRING (SYMBOL_NAME (tail))) == size_byte
- && XSTRING (SYMBOL_NAME (tail))->size == size
- && !bcmp (XSTRING (SYMBOL_NAME (tail))->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;
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;
/* 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. */
{
Lisp_Object sym, val;
int offset;
- extern struct buffer buffer_local_symbols;
sym = intern (namestring);
val = allocate_misc ();
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 */
}
#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)
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. */
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));
Vread_with_symbol_positions = Qnil;
DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
- doc: /* An list mapping read symbols to their positions.
+ 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 occurence of the
+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;
+ Vread_symbol_positions_list = Qnil;
DEFVAR_LISP ("load-path", &Vload_path,
doc: /* *List of directories to search for files to load.
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. */);
Vload_history = Qnil;
DEFVAR_LISP ("load-file-name", &Vload_file_name,
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;
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;
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) */