/* Lisp parsing and input streams.
-Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
+Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
#define file_tell ftell
#endif
+static SCM obarrays;
+
/* Hash table read constants. */
static Lisp_Object Qhash_table, Qdata;
static Lisp_Object Qtest, Qsize;
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
-static Lisp_Object load_unwind (Lisp_Object);
\f
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
else
{
c = BUF_FETCH_BYTE (inbuffer, pt_byte);
- if (! ASCII_BYTE_P (c))
+ if (! ASCII_CHAR_P (c))
c = BYTE8_TO_CHAR (c);
pt_byte++;
}
else
{
c = BUF_FETCH_BYTE (inbuffer, bytepos);
- if (! ASCII_BYTE_P (c))
+ if (! ASCII_CHAR_P (c))
c = BYTE8_TO_CHAR (c);
bytepos++;
}
return c;
if (multibyte)
*multibyte = 1;
- if (ASCII_BYTE_P (c))
+ if (ASCII_CHAR_P (c))
return c;
if (emacs_mule_encoding)
return read_emacs_mule_char (c, readbyte, readcharfun);
c = DECODE_CHAR (charset, code);
if (c < 0)
Fsignal (Qinvalid_read_syntax,
- Fcons (build_string ("invalid multibyte form"), Qnil));
+ list1 (build_string ("invalid multibyte form")));
return c;
}
bool error_nonascii, bool input_method, Lisp_Object seconds)
{
Lisp_Object val, delayed_switch_frame;
- EMACS_TIME end_time;
+ struct timespec end_time;
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
if (NUMBERP (seconds))
{
double duration = extract_float (seconds);
- EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
- end_time = add_emacs_time (current_emacs_time (), wait_time);
+ struct timespec wait_time = dtotimespec (duration);
+ end_time = timespec_add (current_timespec (), wait_time);
}
/* Read until we get an acceptable event. */
{
if (error_nonascii)
{
- Vunread_command_events = Fcons (val, Qnil);
+ Vunread_command_events = list1 (val);
error ("Non-character input-event");
}
else
/* Callback for record_unwind_protect. Restore the old load list OLD,
after loading a file successfully. */
-static Lisp_Object
+static void
record_load_unwind (Lisp_Object old)
{
- return Vloads_in_progress = old;
+ Vloads_in_progress = old;
}
/* This handler function is used via internal_condition_case_1. */
return Qnil;
}
-static Lisp_Object
+static void
load_warn_old_style_backquotes (Lisp_Object file)
{
if (!NILP (Vold_style_backquotes))
args[1] = file;
Fmessage (2, args);
}
- return Qnil;
}
DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
return value of `get-load-suffixes' is used, i.e. the file name is
required to have a non-empty suffix.
+When searching suffixes, this function normally stops at the first
+one that exists. If the option `load-prefer-newer' is non-nil,
+however, it tries all suffixes, and uses whichever file is the newest.
+
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'.
is bound to the file's name.
Return t if the file exists and loads successfully. */)
- (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
+ (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
+ Lisp_Object nosuffix, Lisp_Object must_suffix)
{
- register FILE *stream;
- register int fd = -1;
- ptrdiff_t count = SPECPDL_INDEX ();
+ FILE *stream = NULL;
+ int fd;
+ dynwind_begin ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
/* True means we printed the ".el is newer" message. */
Lisp_Object handler;
bool safe_p = 1;
const char *fmode = "r";
- Lisp_Object tmp[2];
int version;
#ifdef DOS_NT
{
file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
Qt, load_error_handler);
- if (NILP (file))
- return Qnil;
+ if (NILP (file)) {
+ dynwind_end ();
+ 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 (SBYTES (file) > 0)
+ if (SCHARS (file) == 0)
{
- ptrdiff_t size = SBYTES (file);
-
+ fd = -1;
+ errno = ENOENT;
+ }
+ else
+ {
+ Lisp_Object suffixes;
found = Qnil;
GCPRO2 (file, found);
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;
must_suffix = Qnil;
}
- fd = openp (Vload_path, file,
- (!NILP (nosuffix) ? Qnil
- : !NILP (must_suffix) ? Fget_load_suffixes ()
- : Fappend (2, (tmp[0] = Fget_load_suffixes (),
- tmp[1] = Vload_file_rep_suffixes,
- tmp))),
- &found, Qnil);
+ if (!NILP (nosuffix))
+ suffixes = Qnil;
+ else
+ {
+ suffixes = Fget_load_suffixes ();
+ if (NILP (must_suffix))
+ {
+ Lisp_Object arg[2];
+ arg[0] = suffixes;
+ arg[1] = Vload_file_rep_suffixes;
+ suffixes = Fappend (2, arg);
+ }
+ }
+
+ fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
UNGCPRO;
}
if (fd == -1)
{
if (NILP (noerror))
- xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
+ report_file_error ("Cannot open load file", file);
+ dynwind_end ();
return Qnil;
}
handler = Ffind_file_name_handler (found, Qt);
else
handler = Ffind_file_name_handler (found, Qload);
- if (! NILP (handler))
- return call5 (handler, Qload, found, noerror, nomessage, Qt);
+ if (! NILP (handler)) {
+ dynwind_end ();
+ return call5 (handler, Qload, found, noerror, nomessage, Qt);
+ }
#ifdef DOS_NT
/* Tramp has to deal with semi-broken packages that prepend
drive letters to remote files. For that reason, Tramp
#endif
}
+ if (fd >= 0)
+ {
+ record_unwind_protect_ptr (close_file_ptr_unwind, &fd);
+ record_unwind_protect_ptr (fclose_ptr_unwind, &stream);
+ }
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
Lisp_Object tem;
for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
- {
- if (fd >= 0)
- emacs_close (fd);
- signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
- }
+ signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
/* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
- ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
- tmp[1] = Ffile_name_nondirectory (found),
- tmp))
+ ? concat2 (Ffile_name_directory (file),
+ Ffile_name_nondirectory (found))
: found) ;
version = -1;
{
safe_p = 0;
if (!load_dangerous_libraries)
- {
- if (fd >= 0)
- emacs_close (fd);
- error ("File `%s' was not compiled in Emacs",
- SDATA (found));
- }
+ error ("File `%s' was not compiled in Emacs", SDATA (found));
else if (!NILP (nomessage) && !force_load_messages)
message_with_string ("File `%s' not compiled in Emacs", found, 1);
}
#ifdef DOS_NT
fmode = "rb";
#endif /* DOS_NT */
- result = stat (SSDATA (efound), &s1);
- if (result == 0)
- {
- SSET (efound, SBYTES (efound) - 1, 0);
- result = stat (SSDATA (efound), &s2);
- SSET (efound, SBYTES (efound) - 1, 'c');
- }
- if (result == 0
- && EMACS_TIME_LT (get_stat_mtime (&s1), get_stat_mtime (&s2)))
- {
- /* Make the progress messages mention that source is newer. */
- newer = 1;
+ /* 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)
+ {
+ result = stat (SSDATA (efound), &s1);
+ if (result == 0)
+ {
+ SSET (efound, SBYTES (efound) - 1, 0);
+ result = stat (SSDATA (efound), &s2);
+ SSET (efound, SBYTES (efound) - 1, 'c');
+ }
- /* If we won't print another message, mention this anyway. */
- if (!NILP (nomessage) && !force_load_messages)
- {
- 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",
- msg_file, 1);
- }
- }
+ if (result == 0
+ && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0)
+ {
+ /* Make the progress messages mention that source is newer. */
+ newer = 1;
+
+ /* If we won't print another message, mention this anyway. */
+ if (!NILP (nomessage) && !force_load_messages)
+ {
+ 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",
+ msg_file, 1);
+ }
+ }
+ } /* !load_prefer_newer */
UNGCPRO;
}
}
Lisp_Object val;
if (fd >= 0)
- emacs_close (fd);
+ {
+ emacs_close (fd);
+ fd = -1;
+ }
val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
(NILP (nomessage) || force_load_messages) ? Qnil : Qt);
- return unbind_to (count, val);
+ dynwind_end ();
+ return val;
}
}
GCPRO3 (file, found, hist_file_name);
-#ifdef WINDOWSNT
- efound = ENCODE_FILE (found);
- /* If we somehow got here with fd == -2, meaning the file is deemed
- to be remote, don't even try to reopen the file locally; just
- force a failure instead. */
- if (fd >= 0)
+ if (fd < 0)
{
- emacs_close (fd);
- stream = emacs_fopen (SSDATA (efound), fmode);
+ /* We somehow got here with fd == -2, meaning the file is deemed
+ to be remote. Don't even try to reopen the file locally;
+ just force a failure. */
+ stream = NULL;
+ errno = EINVAL;
}
else
- stream = NULL;
-#else /* not WINDOWSNT */
- stream = fdopen (fd, fmode);
-#endif /* not WINDOWSNT */
- if (stream == 0)
{
+#ifdef WINDOWSNT
emacs_close (fd);
- error ("Failure to create stdio stream for %s", SDATA (file));
+ fd = -1;
+ efound = ENCODE_FILE (found);
+ stream = emacs_fopen (SSDATA (efound), fmode);
+#else
+ stream = fdopen (fd, fmode);
+#endif
}
+ if (! stream)
+ report_file_error ("Opening stdio stream", file);
if (! NILP (Vpurify_flag))
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
message_with_string ("Loading %s...", file, 1);
}
- record_unwind_protect (load_unwind, make_save_pointer (stream));
specbind (Qload_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
}
- unbind_to (count, Qnil);
+ dynwind_end ();
/* Run any eval-after-load forms for this file. */
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
return Qt;
}
-
-static Lisp_Object
-load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
-{
- FILE *stream = XSAVE_POINTER (arg, 0);
- if (stream != NULL)
- {
- block_input ();
- fclose (stream);
- unblock_input ();
- }
- return Qnil;
-}
\f
static bool
complete_filename_p (Lisp_Object pathname)
(Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
{
Lisp_Object file;
- int fd = openp (path, filename, suffixes, &file, predicate);
- if (NILP (predicate) && fd > 0)
- close (fd);
+ int fd = openp (path, filename, suffixes, &file, predicate, false);
+ if (NILP (predicate) && fd >= 0)
+ emacs_close (fd);
return file;
}
nil is stored there on failure.
If the file we find is remote, return -2
- but store the found remote file name in *STOREPTR. */
+ but store the found remote file name in *STOREPTR.
+
+ If NEWER is true, try all SUFFIXes and return the result for the
+ newest file that exists. Does not apply to remote files,
+ or if PREDICATE is specified. */
int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
- Lisp_Object *storeptr, Lisp_Object predicate)
+ Lisp_Object *storeptr, Lisp_Object predicate, bool newer)
{
ptrdiff_t fn_size = 100;
char buf[100];
char *fn = buf;
- bool absolute = 0;
+ bool absolute;
ptrdiff_t want_length;
Lisp_Object filename;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
- Lisp_Object string, tail, encoded_fn;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7;
+ Lisp_Object string, tail, encoded_fn, save_string;
ptrdiff_t max_suffix_len = 0;
int last_errno = ENOENT;
+ int save_fd = -1;
+
+ /* The last-modified time of the newest matching file found.
+ Initialize it to something less than all valid timestamps. */
+ struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1);
CHECK_STRING (str);
SBYTES (XCAR (tail)));
}
- string = filename = encoded_fn = Qnil;
- GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
+ string = filename = encoded_fn = save_string = Qnil;
+ GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn);
if (storeptr)
*storeptr = Qnil;
- if (complete_filename_p (str))
- absolute = 1;
+ absolute = complete_filename_p (str);
for (; CONSP (path); path = XCDR (path))
{
fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
- for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
+ for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
+ Lisp_Object suffix = XCAR (tail);
+ ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
Lisp_Object handler;
/* Concatenate path element/specified name with the suffix.
? 2 : 0);
fnlen = SBYTES (filename) - prefixlen;
memcpy (fn, SDATA (filename) + prefixlen, fnlen);
- memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1);
+ memcpy (fn + fnlen, SDATA (suffix), lsuffix + 1);
fnlen += 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". */
- string = make_string (fn, fnlen);
+ /* make_string has its own ideas on when to return a unibyte
+ string and when a multibyte string, but we know better.
+ We must have a unibyte string when dumping, since
+ file-name encoding is shaky at best at that time, and in
+ particular default-file-name-coding-system is reset
+ several times during loadup. We therefore don't want to
+ encode the file before passing it to file I/O library
+ functions. */
+ if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix))
+ string = make_unibyte_string (fn, fnlen);
+ else
+ string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
bool exists;
- last_errno = ENOENT;
if (NILP (predicate))
exists = !NILP (Ffile_readable_p (string));
else
{
Lisp_Object tmp = call1 (predicate, string);
if (NILP (tmp))
- exists = 0;
+ exists = false;
else if (EQ (tmp, Qdir_ok)
|| NILP (Ffile_directory_p (string)))
- exists = 1;
+ exists = true;
else
{
- exists = 0;
+ exists = false;
last_errno = EISDIR;
}
}
if (exists)
{
- /* We succeeded; return this descriptor and filename. */
- if (storeptr)
- *storeptr = string;
- UNGCPRO;
- return -2;
+ /* We succeeded; return this descriptor and filename. */
+ if (storeptr)
+ *storeptr = string;
+ UNGCPRO;
+ return -2;
}
}
else
{
int fd;
const char *pfn;
+ struct stat st;
encoded_fn = ENCODE_FILE (string);
pfn = SSDATA (encoded_fn);
{
fd = emacs_open (pfn, O_RDONLY, 0);
if (fd < 0)
- last_errno = errno;
+ {
+ if (errno != ENOENT)
+ last_errno = errno;
+ }
else
{
- struct stat st;
int err = (fstat (fd, &st) != 0 ? errno
: S_ISDIR (st.st_mode) ? EISDIR : 0);
if (err)
if (fd >= 0)
{
- /* We succeeded; return this descriptor and filename. */
- if (storeptr)
- *storeptr = string;
- UNGCPRO;
- return fd;
+ if (newer && !NATNUMP (predicate))
+ {
+ struct timespec mtime = get_stat_mtime (&st);
+
+ if (timespec_cmp (mtime, save_mtime) <= 0)
+ emacs_close (fd);
+ else
+ {
+ if (0 <= save_fd)
+ emacs_close (save_fd);
+ save_fd = fd;
+ save_mtime = mtime;
+ save_string = string;
+ }
+ }
+ else
+ {
+ /* We succeeded; return this descriptor and filename. */
+ if (storeptr)
+ *storeptr = string;
+ UNGCPRO;
+ return fd;
+ }
}
+
+ /* No more suffixes. Return the newest. */
+ if (0 <= save_fd && ! CONSP (XCDR (tail)))
+ {
+ if (storeptr)
+ *storeptr = save_string;
+ UNGCPRO;
+ return save_fd;
+ }
}
}
if (absolute)
Vload_history);
}
-static Lisp_Object
-readevalloop_1 (Lisp_Object old)
+static void
+readevalloop_1 (int old)
{
- load_convert_to_unibyte = ! NILP (old);
- return Qnil;
+ load_convert_to_unibyte = old;
}
/* Signal an `end-of-file' error, if possible with file name
xsignal0 (Qend_of_file);
}
+static Lisp_Object
+readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
+{
+ /* If we macroexpand the toplevel form non-recursively and it ends
+ up being a `progn' (or if it was a progn to start), treat each
+ form in the progn as a top-level form. This way, if one form in
+ the progn defines a macro, that macro is in effect when we expand
+ the remaining forms. See similar code in bytecomp.el. */
+ val = call2 (macroexpand, val, Qnil);
+ if (EQ (CAR_SAFE (val), Qprogn))
+ {
+ Lisp_Object subforms = XCDR (val);
+ val = Qnil;
+ for (; CONSP (subforms); subforms = XCDR (subforms))
+ val = readevalloop_eager_expand_eval (XCAR (subforms),
+ macroexpand);
+ }
+ else
+ val = eval_sub (call2 (macroexpand, val, Qt));
+
+ return val;
+}
+
/* UNIBYTE specifies how to set load_convert_to_unibyte
for this invocation.
READFUN, if non-nil, is used instead of `read'.
{
register int c;
register Lisp_Object val;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
bool continue_reading_p;
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
- record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
+ record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
load_convert_to_unibyte = !NILP (unibyte);
/* If lexical binding is active (either because it was specified in
lexical environment, otherwise, turn off lexical binding. */
lex_bound = find_symbol_value (Qlexical_binding);
specbind (Qinternal_interpreter_environment,
- NILP (lex_bound) || EQ (lex_bound, Qunbound)
- ? Qnil : Fcons (Qt, Qnil));
+ (NILP (lex_bound) || EQ (lex_bound, Qunbound)
+ ? Qnil : list1 (Qt)));
GCPRO4 (sourcename, readfun, start, end);
continue_reading_p = 1;
while (continue_reading_p)
{
- ptrdiff_t count1 = SPECPDL_INDEX ();
+ dynwind_begin ();
if (b != 0 && !BUFFER_LIVE_P (b))
error ("Reading from killed buffer");
}
if (c < 0)
{
- unbind_to (count1, Qnil);
+ dynwind_end ();
break;
}
start = Fpoint_marker ();
/* Restore saved point and BEGV. */
- unbind_to (count1, Qnil);
+ dynwind_end ();
/* Now eval what we just read. */
if (!NILP (macroexpand))
- val = call1 (macroexpand, val);
- val = eval_sub (val);
+ val = readevalloop_eager_expand_eval (val, macroexpand);
+ else
+ val = eval_sub (val);
if (printflag)
{
UNGCPRO;
- unbind_to (count, Qnil);
+ dynwind_end ();
}
DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
This function preserves the position of point. */)
(Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object tem, buf;
if (NILP (buffer))
specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
readevalloop (buf, 0, filename,
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
- unbind_to (count, Qnil);
+ dynwind_end ();
return Qnil;
}
(Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
{
/* FIXME: Do the eval-sexp-add-defvars dance! */
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object tem, cbuf;
cbuf = Fcurrent_buffer ();
!NILP (printflag), Qnil, read_function,
start, end);
- return unbind_to (count, Qnil);
+ dynwind_end ();
+ return Qnil;
}
\f
if (EQ (stream, Qt))
stream = Qread_char;
if (EQ (stream, Qread_char))
- /* FIXME: ¿¡ When is this used !? */
+ /* FIXME: ?! When is this used !? */
return call1 (intern ("read-minibuffer"),
build_string ("Lisp expression: "));
XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
}
- invalid_syntax ("#^^");
+ invalid_syntax ("#^" "^");
}
invalid_syntax ("#^");
}
if (c == '"')
{
Lisp_Object tmp, val;
- EMACS_INT size_in_chars
- = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length));
+ unsigned char *data;
UNREAD (c);
tmp = read1 (readcharfun, pch, first_in_list);
== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
invalid_syntax ("#&...");
- val = Fmake_bool_vector (length, Qnil);
- memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars);
+ val = make_uninit_bool_vector (XFASTINT (length));
+ data = bool_vector_uchar_data (val);
+ memcpy (data, SDATA (tmp), size_in_chars);
/* Clear the extraneous bits in the last byte. */
if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
- XBOOL_VECTOR (val)->data[size_in_chars - 1]
+ data[size_in_chars - 1]
&= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
return val;
}
/* Accept compiled functions at read-time so that we don't have to
build them using function calls. */
Lisp_Object tmp;
+ struct Lisp_Vector *vec;
tmp = read_vector (readcharfun, 1);
- make_byte_code (XVECTOR (tmp));
+ vec = XVECTOR (tmp);
+ if (vec->header.size == 0)
+ invalid_syntax ("Empty byte-code object");
+ make_byte_code (vec);
return tmp;
}
if (c == '(')
if (saved_doc_string_size == 0)
{
- saved_doc_string = xmalloc (nskip + extra);
+ saved_doc_string = xmalloc_atomic (nskip + extra);
saved_doc_string_size = nskip + extra;
}
if (nskip > saved_doc_string_size)
if (c == '$')
return Vload_file_name;
if (c == '\'')
- return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
+ return list2 (Qfunction, read0 (readcharfun));
/* #:foo is the uninterned symbol named foo. */
if (c == ':')
{
goto retry;
case '\'':
- {
- return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
- }
+ return list2 (Qquote, read0 (readcharfun));
case '`':
{
value = read0 (readcharfun);
new_backquote_flag = saved_new_backquote_flag;
- return Fcons (Qbackquote, Fcons (value, Qnil));
+ return list2 (Qbackquote, value);
}
}
case ',':
}
value = read0 (readcharfun);
- return Fcons (comma_type, Fcons (value, Qnil));
+ return list2 (comma_type, value);
}
else
{
/* Recurse according to subtree's type.
Every branch must return a Lisp_Object. */
- switch (XTYPE (subtree))
+ if (VECTORLIKEP (subtree))
{
- case Lisp_Vectorlike:
- {
- ptrdiff_t i, length = 0;
- if (BOOL_VECTOR_P (subtree))
- return subtree; /* No sub-objects anyway. */
- else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
- || COMPILEDP (subtree))
- length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
- else if (VECTORP (subtree))
- length = ASIZE (subtree);
- else
- /* An unknown pseudovector may contain non-Lisp fields, so we
- can't just blindly traverse all its fields. We used to call
- `Flength' which signaled `sequencep', so I just preserved this
- behavior. */
- wrong_type_argument (Qsequencep, subtree);
-
- for (i = 0; i < length; i++)
- SUBSTITUTE (AREF (subtree, i),
- ASET (subtree, i, true_value));
- return subtree;
- }
-
- case Lisp_Cons:
- {
- SUBSTITUTE (XCAR (subtree),
- XSETCAR (subtree, true_value));
- SUBSTITUTE (XCDR (subtree),
- XSETCDR (subtree, true_value));
- return subtree;
- }
-
- case Lisp_String:
- {
- /* Check for text properties in each interval.
- substitute_in_interval contains part of the logic. */
+ ptrdiff_t i, length = 0;
+ if (BOOL_VECTOR_P (subtree))
+ return subtree; /* No sub-objects anyway. */
+ else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
+ || COMPILEDP (subtree) || HASH_TABLE_P (subtree))
+ length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
+ else if (VECTORP (subtree))
+ length = ASIZE (subtree);
+ else
+ /* An unknown pseudovector may contain non-Lisp fields, so we
+ can't just blindly traverse all its fields. We used to call
+ `Flength' which signaled `sequencep', so I just preserved this
+ behavior. */
+ wrong_type_argument (Qsequencep, subtree);
+
+ for (i = 0; i < length; i++)
+ SUBSTITUTE (AREF (subtree, i),
+ ASET (subtree, i, true_value));
+ return subtree;
+ }
+ else if (CONSP (subtree))
+ {
+ SUBSTITUTE (XCAR (subtree),
+ XSETCAR (subtree, true_value));
+ SUBSTITUTE (XCDR (subtree),
+ XSETCDR (subtree, true_value));
+ return subtree;
+ }
+ else if (STRINGP (subtree))
+ {
+ /* Check for text properties in each interval.
+ substitute_in_interval contains part of the logic. */
- INTERVAL root_interval = string_intervals (subtree);
- Lisp_Object arg = Fcons (object, placeholder);
+ INTERVAL root_interval = string_intervals (subtree);
+ Lisp_Object arg = Fcons (object, placeholder);
- traverse_intervals_noorder (root_interval,
- &substitute_in_interval, arg);
+ traverse_intervals_noorder (root_interval,
+ &substitute_in_interval, arg);
- return subtree;
- }
-
- /* Other types don't recurse any further. */
- default:
return subtree;
}
+ else
+ /* Other types don't recurse any further. */
+ return subtree;
}
/* Helper function for substitute_object_recurse. */
ptrdiff_t i, size;
Lisp_Object *ptr;
Lisp_Object tem, item, vector;
- struct Lisp_Cons *otem;
Lisp_Object len;
tem = read_list (1, readcharfun);
if (!CONSP (item))
error ("Invalid byte code");
- otem = XCONS (item);
bytestr = XCAR (item);
item = XCDR (item);
- free_cons (otem);
}
/* Now handle the bytecode slot. */
}
}
ASET (vector, i, item);
- otem = XCONS (tem);
tem = Fcdr (tem);
- free_cons (otem);
}
return vector;
}
-/* FLAG means check for ] to terminate rather than ) and . */
+/* FLAG means check for ']' to terminate rather than ')' and '.'. */
static Lisp_Object
read_list (bool flag, Lisp_Object readcharfun)
}
invalid_syntax ("] in a list");
}
- tem = Fcons (elt, Qnil);
+ tem = list1 (elt);
if (!NILP (tail))
XSETCDR (tail, tem);
else
\f
static Lisp_Object initial_obarray;
-/* `oblookup' stores the bucket number here, for the sake of Funintern. */
-
-static size_t oblookup_last_bucket_number;
+Lisp_Object
+obhash (Lisp_Object obarray)
+{
+ Lisp_Object tem = scm_hashq_get_handle (obarrays, obarray);
+ if (SCM_UNLIKELY (scm_is_false (tem)))
+ tem = scm_hashq_create_handle_x (obarrays, obarray,
+ scm_make_obarray ());
+ return scm_cdr (tem);
+}
/* Get an error if OBARRAY is not an obarray.
If it is one, return it. */
tem = oblookup (obarray, SSDATA (string),
SCHARS (string),
SBYTES (string));
- if (!INTEGERP (tem))
+ if (SYMBOLP (tem))
return tem;
if (!NILP (Vpurify_flag))
string = Fpurecopy (string);
- sym = Fmake_symbol (string);
- if (EQ (obarray, initial_obarray))
- XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
- else
- XSYMBOL (sym)->interned = SYMBOL_INTERNED;
+ sym = scm_intern (scm_from_utf8_stringn (SSDATA (string),
+ SBYTES (string)),
+ obhash (obarray));
+ initialize_symbol (sym, string);
if ((SREF (string, 0) == ':')
&& EQ (obarray, initial_obarray))
{
- XSYMBOL (sym)->constant = 1;
- XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
+ SET_SYMBOL_CONSTANT (XSYMBOL (sym), 1);
+ SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_PLAINVAL);
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
- ptr = aref_addr (obarray, XINT(tem));
- if (SYMBOLP (*ptr))
- set_symbol_next (sym, XSYMBOL (*ptr));
- else
- set_symbol_next (sym, NULL);
- *ptr = sym;
- return sym;
+ return scm_intern (scm_from_utf8_stringn (SSDATA (string),
+ SBYTES (string)),
+ obhash (obarray));
}
DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
else
return tem;
}
+
+DEFUN ("find-symbol", Ffind_symbol, Sfind_symbol, 1, 2, 0,
+ doc: /* find-symbol */)
+ (Lisp_Object string, Lisp_Object obarray)
+{
+ Lisp_Object tem;
+
+ obarray = check_obarray (NILP (obarray) ? Vobarray : obarray);
+ CHECK_STRING (string);
+
+ tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
+ if (INTEGERP (tem))
+ return scm_values (scm_list_2 (Qnil, Qnil));
+ else
+ return scm_values (scm_list_2 (tem, Qt));
+}
\f
DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
doc: /* Delete the symbol named NAME, if any, from OBARRAY.
The value is t if a symbol was found and deleted, nil otherwise.
NAME may be a string or a symbol. If it is a symbol, that symbol
is deleted, if it belongs to OBARRAY--no other symbol is deleted.
-OBARRAY defaults to the value of the variable `obarray'. */)
+OBARRAY, if nil, defaults to the value of the variable `obarray'.
+usage: (unintern NAME OBARRAY) */)
(Lisp_Object name, Lisp_Object obarray)
{
- register Lisp_Object string, tem;
- size_t hash;
+ Lisp_Object string;
+ Lisp_Object tem;
- if (NILP (obarray)) obarray = Vobarray;
+ if (NILP (obarray))
+ obarray = Vobarray;
obarray = check_obarray (obarray);
if (SYMBOLP (name))
- string = SYMBOL_NAME (name);
- else
{
- CHECK_STRING (name);
- string = name;
- }
-
- tem = oblookup (obarray, SSDATA (string),
- SCHARS (string),
- SBYTES (string));
- if (INTEGERP (tem))
- return Qnil;
- /* If arg was a symbol, don't delete anything but that symbol itself. */
- if (SYMBOLP (name) && !EQ (name, tem))
- return Qnil;
-
- /* There are plenty of other symbols which will screw up the Emacs
- session if we unintern them, as well as even more ways to use
- `setq' or `fset' or whatnot to make the Emacs session
- unusable. Let's not go down this silly road. --Stef */
- /* if (EQ (tem, Qnil) || EQ (tem, Qt))
- error ("Attempt to unintern t or nil"); */
-
- XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
-
- hash = oblookup_last_bucket_number;
-
- if (EQ (AREF (obarray, hash), tem))
- {
- if (XSYMBOL (tem)->next)
- {
- Lisp_Object sym;
- XSETSYMBOL (sym, XSYMBOL (tem)->next);
- ASET (obarray, hash, sym);
- }
- else
- ASET (obarray, hash, make_number (0));
+ if (! EQ (name,
+ scm_find_symbol (scm_symbol_to_string (name),
+ obhash (obarray))))
+ return Qnil;
+ string = SYMBOL_NAME (name);
}
else
{
- Lisp_Object tail, following;
-
- for (tail = AREF (obarray, hash);
- XSYMBOL (tail)->next;
- tail = following)
- {
- XSETSYMBOL (following, XSYMBOL (tail)->next);
- if (EQ (following, tem))
- {
- set_symbol_next (tail, XSYMBOL (following)->next);
- break;
- }
- }
+ CHECK_STRING (name);
+ string = name;
+
}
- return Qt;
+ return (scm_is_true (scm_unintern (name, obhash (obarray))) ? Qt : Qnil);
}
\f
/* Return the symbol in OBARRAY whose names matches the string
of SIZE characters (SIZE_BYTE bytes) at PTR.
- If there is no such symbol in OBARRAY, return nil.
+ If there is no such symbol, return the integer bucket number of
+ where the symbol would be if it were present.
Also store the bucket number in oblookup_last_bucket_number. */
Lisp_Object
oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
{
- size_t hash;
- size_t obsize;
- register Lisp_Object tail;
- Lisp_Object bucket, tem;
+ Lisp_Object sym;
+ Lisp_Object string2 = scm_from_utf8_stringn (ptr, size_byte);
obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
-
- /* This is sometimes needed in the middle of GC. */
- obsize &= ~ARRAY_MARK_FLAG;
- hash = hash_string (ptr, size_byte) % obsize;
- bucket = AREF (obarray, hash);
- oblookup_last_bucket_number = hash;
- if (EQ (bucket, make_number (0)))
- ;
- else if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray"); /* Like CADR error message. */
+ sym = scm_find_symbol (string2, obhash (obarray));
+ if (scm_is_true (sym)
+ && scm_is_true (scm_module_variable (symbol_module, sym)))
+ {
+ if (EQ (sym, Qnil_))
+ return Qnil;
+ else if (EQ (sym, Qt_))
+ return Qt;
+ else
+ return sym;
+ }
else
- for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
- {
- if (SBYTES (SYMBOL_NAME (tail)) == size_byte
- && SCHARS (SYMBOL_NAME (tail)) == size
- && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
- return tail;
- else if (XSYMBOL (tail)->next == 0)
- break;
- }
- XSETINT (tem, hash);
- return tem;
+ return make_number (0);
}
\f
void
map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
{
- ptrdiff_t i;
- register Lisp_Object tail;
+ Lisp_Object proc (Lisp_Object sym)
+ {
+ Lisp_Object tem = Ffind_symbol (SYMBOL_NAME (sym), obarray);
+ if (scm_is_true (scm_c_value_ref (tem, 1))
+ && EQ (sym, scm_c_value_ref (tem, 0)))
+ fn (sym, arg);
+ return SCM_UNSPECIFIED;
+ }
CHECK_VECTOR (obarray);
- for (i = ASIZE (obarray) - 1; i >= 0; i--)
- {
- tail = AREF (obarray, i);
- if (SYMBOLP (tail))
- while (1)
- {
- (*fn) (tail, arg);
- if (XSYMBOL (tail)->next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->next);
- }
- }
+ scm_obarray_for_each (scm_c_make_gsubr ("proc", 1, 0, 0, proc),
+ obhash (obarray));
}
static void
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
- /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
- NILP (Vpurify_flag) check in intern_c_string. */
- Qnil = make_number (-1); Vpurify_flag = make_number (1);
- Qnil = intern_c_string ("nil");
+ obarrays = scm_make_hash_table (SCM_UNDEFINED);
+ scm_hashq_set_x (obarrays, Vobarray, SCM_UNDEFINED);
+
+ Qnil = SCM_ELISP_NIL;
+ Qt = SCM_BOOL_T;
- /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
- so those two need to be fixed manually. */
+ Qnil_ = intern_c_string ("nil");
+ SET_SYMBOL_VAL (XSYMBOL (Qnil_), Qnil);
+ SET_SYMBOL_CONSTANT (XSYMBOL (Qnil_), 1);
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qnil_), 1);
+
+ Qt_ = intern_c_string ("t");
+ SET_SYMBOL_VAL (XSYMBOL (Qt_), Qt);
+ SET_SYMBOL_CONSTANT (XSYMBOL (Qt_), 1);
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qt_), 1);
+
+ Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
- set_symbol_function (Qunbound, Qnil);
- set_symbol_plist (Qunbound, Qnil);
- SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
- XSYMBOL (Qnil)->constant = 1;
- XSYMBOL (Qnil)->declared_special = 1;
- set_symbol_plist (Qnil, Qnil);
- set_symbol_function (Qnil, Qnil);
-
- Qt = intern_c_string ("t");
- SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
- XSYMBOL (Qnil)->declared_special = 1;
- XSYMBOL (Qt)->constant = 1;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
Vpurify_flag = Qt;
DEFSYM (Qvariable_documentation, "variable-documentation");
- read_buffer = xmalloc (size);
+ read_buffer = xmalloc_atomic (size);
read_buffer_size = size;
}
\f
void
-defsubr (struct Lisp_Subr *sname)
-{
- Lisp_Object sym, tem;
- sym = intern_c_string (sname->symbol_name);
- XSETPVECTYPE (sname, PVEC_SUBR);
- XSETSUBR (tem, sname);
- set_symbol_function (sym, tem);
-}
-
-#ifdef NOTDEF /* Use fset in subr.el now! */
-void
-defalias (struct Lisp_Subr *sname, char *string)
+defsubr (const char *lname, scm_t_subr gsubr_fn, short min_args, short max_args, const char *intspec)
{
- Lisp_Object sym;
- sym = intern (string);
- XSETSUBR (XSYMBOL (sym)->function, sname);
+ Lisp_Object sym = intern_c_string (lname);
+ Lisp_Object fn;
+ switch (max_args)
+ {
+ case MANY:
+ fn = scm_c_make_gsubr (lname, 0, 0, 1, gsubr_fn);
+ break;
+ case UNEVALLED:
+ fn = Fcons (Qspecial_operator,
+ scm_c_make_gsubr (lname, 0, 0, 1, gsubr_fn));
+ break;
+ default:
+ fn = scm_c_make_gsubr (lname, min_args, max_args - min_args, 0, gsubr_fn);
+ break;
+ }
+ set_symbol_function (sym, fn);
+ if (intspec)
+ {
+ Lisp_Object tem = ((*intspec != '(')
+ ? build_string (intspec)
+ : Fcar (Fread_from_string (build_string (intspec),
+ Qnil, Qnil)));
+ scm_set_procedure_property_x (fn, Qinteractive_form, tem);
+ }
}
-#endif /* NOTDEF */
/* Define an "integer variable"; a symbol whose value is forwarded to a
C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile):
sym = intern_c_string (namestring);
i_fwd->type = Lisp_Fwd_Int;
i_fwd->intvar = address;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1);
+ SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED);
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
}
sym = intern_c_string (namestring);
b_fwd->type = Lisp_Fwd_Bool;
b_fwd->boolvar = address;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1);
+ SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED);
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
}
sym = intern_c_string (namestring);
o_fwd->type = Lisp_Fwd_Obj;
o_fwd->objvar = address;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1);
+ SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED);
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
}
sym = intern_c_string (namestring);
ko_fwd->type = Lisp_Fwd_Kboard_Obj;
ko_fwd->offset = offset;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1);
+ SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED);
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
\f
-/* Check that the elements of Vload_path exist. */
+/* Check that the elements of lpath exist. */
static void
-load_path_check (void)
+load_path_check (Lisp_Object lpath)
{
Lisp_Object path_tail;
/* The only elements that might not exist are those from
PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if
it exists. */
- for (path_tail = Vload_path; !NILP (path_tail); path_tail = XCDR (path_tail))
+ for (path_tail = lpath; !NILP (path_tail); path_tail = XCDR (path_tail))
{
Lisp_Object dirfile;
dirfile = Fcar (path_tail);
}
}
-/* Record the value of load-path used at the start of dumping
- so we can see if the site changed it later during dumping. */
-static Lisp_Object dump_path;
+/* Return the default load-path, to be used if EMACSLOADPATH is unset.
+ This does not include the standard site-lisp directories
+ under the installation prefix (i.e., PATH_SITELOADSEARCH),
+ but it does (unless no_site_lisp is set) include site-lisp
+ directories in the source/build directories if those exist and we
+ are running uninstalled.
-/* Compute the default Vload_path, with the following logic:
- If CANNOT_DUMP:
- use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH,
- prepending PATH_SITELOADSEARCH unless --no-site-lisp.
+ Uses the following logic:
+ If CANNOT_DUMP: Use PATH_LOADSEARCH.
The remainder is what happens when dumping works:
If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH.
- Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH.
+ Otherwise use PATH_LOADSEARCH.
- If !initialized, then just set both Vload_path and dump_path.
- If initialized, then if Vload_path != dump_path, do nothing.
- (Presumably the load-path has already been changed by something.
- This can only be from a site-load file during dumping,
- or because EMACSLOADPATH is set.)
+ If !initialized, then just return PATH_DUMPLOADSEARCH.
+ If initialized:
If Vinstallation_directory is not nil (ie, running uninstalled):
If installation-dir/lisp exists and not already a member,
we must be running uninstalled. Reset the load-path
to just installation-dir/lisp. (The default PATH_LOADSEARCH
refers to the eventual installation directories. Since we
are not yet installed, we should not use them, even if they exist.)
- If installation-dir/lisp does not exist, just add dump_path at the
- end instead.
- Add installation-dir/leim (if exists and not already a member) at the front.
+ If installation-dir/lisp does not exist, just add
+ PATH_DUMPLOADSEARCH at the end instead.
Add installation-dir/site-lisp (if !no_site_lisp, and exists
and not already a member) at the front.
If installation-dir != source-dir (ie running an uninstalled,
out-of-tree build) AND install-dir/src/Makefile exists BUT
install-dir/src/Makefile.in does NOT exist (this is a sanity
- check), then repeat the above steps for source-dir/lisp,
- leim and site-lisp.
- Finally, add the site-lisp directories at the front (if !no_site_lisp).
-*/
+ check), then repeat the above steps for source-dir/lisp, site-lisp. */
-void
-init_lread (void)
+static Lisp_Object
+load_path_default (void)
{
+ Lisp_Object lpath = Qnil;
const char *normal;
#ifdef CANNOT_DUMP
normal = PATH_LOADSEARCH;
#ifdef HAVE_NS
- Vload_path = decode_env_path ("EMACSLOADPATH", loadpath ? loadpath : normal);
+ lpath = decode_env_path (0, loadpath ? loadpath : normal, 0);
#else
- Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+ lpath = decode_env_path (0, normal, 0);
#endif
- load_path_check ();
-
- /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added
- to their load-path too, AFAICS. I don't think we can tell the
- difference between initialized and !initialized in this case,
- so we'll have to do it unconditionally when Vinstallation_directory
- is non-nil. */
- if (!no_site_lisp && !egetenv ("EMACSLOADPATH"))
- {
- Lisp_Object sitelisp;
- sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
- if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
- }
#else /* !CANNOT_DUMP */
- if (NILP (Vpurify_flag))
- {
- normal = PATH_LOADSEARCH;
- /* If the EMACSLOADPATH environment variable is set, use its value.
- This doesn't apply if we're dumping. */
- if (egetenv ("EMACSLOADPATH"))
- Vload_path = decode_env_path ("EMACSLOADPATH", normal);
- }
- else
- normal = PATH_DUMPLOADSEARCH;
-
- /* In a dumped Emacs, we normally reset the value of Vload_path using
- PATH_LOADSEARCH, since the value that was dumped uses lisp/ in
- the source directory, instead of the path of the installed elisp
- libraries. However, if it appears that Vload_path has already been
- changed from the default that was saved before dumping, don't
- change it further. Changes can only be due to EMACSLOADPATH, or
- site-lisp files that were processed during dumping. */
+
+ normal = NILP (Vpurify_flag) ? PATH_LOADSEARCH : PATH_DUMPLOADSEARCH;
+
if (initialized)
{
- if (NILP (Fequal (dump_path, Vload_path)))
- {
- /* Do not make any changes, just check the elements exist. */
- /* Note: --no-site-lisp is ignored.
- I don't know what to do about this. */
- load_path_check ();
- }
- else
- {
#ifdef HAVE_NS
- const char *loadpath = ns_load_path ();
- Vload_path = decode_env_path (0, loadpath ? loadpath : normal);
+ const char *loadpath = ns_load_path ();
+ lpath = decode_env_path (0, loadpath ? loadpath : normal, 0);
#else
- Vload_path = decode_env_path (0, normal);
+ lpath = decode_env_path (0, normal, 0);
#endif
- if (!NILP (Vinstallation_directory))
- {
- Lisp_Object tem, tem1;
-
- /* Add to the path the lisp subdir of the installation
- dir, if it is accessible. Note: in out-of-tree builds,
- this directory is empty save for Makefile. */
- tem = Fexpand_file_name (build_string ("lisp"),
- Vinstallation_directory);
- tem1 = Ffile_accessible_directory_p (tem);
- if (!NILP (tem1))
+ if (!NILP (Vinstallation_directory))
+ {
+ Lisp_Object tem, tem1;
+
+ /* Add to the path the lisp subdir of the installation
+ dir, if it is accessible. Note: in out-of-tree builds,
+ this directory is empty save for Makefile. */
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_accessible_directory_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, lpath)))
{
- if (NILP (Fmember (tem, Vload_path)))
- {
- /* We are running uninstalled. The default load-path
- points to the eventual installed lisp, leim
- directories. We should not use those now, even
- if they exist, so start over from a clean slate. */
- Vload_path = Fcons (tem, Qnil);
- }
+ /* We are running uninstalled. The default load-path
+ points to the eventual installed lisp directories.
+ We should not use those now, even if they exist,
+ so start over from a clean slate. */
+ lpath = list1 (tem);
}
- else
- /* That dir doesn't exist, so add the build-time
- Lisp dirs instead. */
- Vload_path = nconc2 (Vload_path, dump_path);
+ }
+ else
+ /* That dir doesn't exist, so add the build-time
+ Lisp dirs instead. */
+ {
+ Lisp_Object dump_path =
+ decode_env_path (0, PATH_DUMPLOADSEARCH, 0);
+ lpath = nconc2 (lpath, dump_path);
+ }
- /* Add leim under the installation dir, if it is accessible. */
- tem = Fexpand_file_name (build_string ("leim"),
+ /* Add site-lisp under the installation dir, if it exists. */
+ if (!no_site_lisp)
+ {
+ tem = Fexpand_file_name (build_string ("site-lisp"),
Vinstallation_directory);
tem1 = Ffile_accessible_directory_p (tem);
if (!NILP (tem1))
{
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
+ if (NILP (Fmember (tem, lpath)))
+ lpath = Fcons (tem, lpath);
}
+ }
+
+ /* If Emacs was not built in the source directory,
+ and it is run from where it was built, add to load-path
+ the lisp and site-lisp dirs under that directory. */
+
+ if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
+ {
+ Lisp_Object tem2;
- /* Add site-lisp under the installation dir, if it exists. */
- if (!no_site_lisp)
+ tem = Fexpand_file_name (build_string ("src/Makefile"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+
+ /* Don't be fooled if they moved the entire source tree
+ AFTER dumping Emacs. If the build directory is indeed
+ different from the source dir, src/Makefile.in and
+ src/Makefile will not be found together. */
+ tem = Fexpand_file_name (build_string ("src/Makefile.in"),
+ Vinstallation_directory);
+ tem2 = Ffile_exists_p (tem);
+ if (!NILP (tem1) && NILP (tem2))
{
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vinstallation_directory);
- tem1 = Ffile_accessible_directory_p (tem);
- if (!NILP (tem1))
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vsource_directory);
+
+ if (NILP (Fmember (tem, lpath)))
+ lpath = Fcons (tem, lpath);
+
+ if (!no_site_lisp)
{
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
+ tem = Fexpand_file_name (build_string ("site-lisp"),
+ Vsource_directory);
+ tem1 = Ffile_accessible_directory_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, lpath)))
+ lpath = Fcons (tem, lpath);
+ }
}
}
+ } /* Vinstallation_directory != Vsource_directory */
- /* If Emacs was not built in the source directory,
- and it is run from where it was built, add to load-path
- the lisp, leim and site-lisp dirs under that directory. */
+ } /* if Vinstallation_directory */
+ }
+ else /* !initialized */
+ {
+ /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
+ source directory. We used to add ../lisp (ie the lisp dir in
+ the build directory) at the front here, but that should not
+ be necessary, since in out of tree builds lisp/ is empty, save
+ for Makefile. */
+ lpath = decode_env_path (0, normal, 0);
+ }
+#endif /* !CANNOT_DUMP */
- if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
- {
- Lisp_Object tem2;
-
- tem = Fexpand_file_name (build_string ("src/Makefile"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
-
- /* Don't be fooled if they moved the entire source tree
- AFTER dumping Emacs. If the build directory is indeed
- different from the source dir, src/Makefile.in and
- src/Makefile will not be found together. */
- tem = Fexpand_file_name (build_string ("src/Makefile.in"),
- Vinstallation_directory);
- tem2 = Ffile_exists_p (tem);
- if (!NILP (tem1) && NILP (tem2))
- {
- tem = Fexpand_file_name (build_string ("lisp"),
- Vsource_directory);
+ return lpath;
+}
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
+void
+init_lread (void)
+{
+ /* First, set Vload_path. */
- tem = Fexpand_file_name (build_string ("leim"),
- Vsource_directory);
+ /* Ignore EMACSLOADPATH when dumping. */
+#ifdef CANNOT_DUMP
+ bool use_loadpath = true;
+#else
+ bool use_loadpath = NILP (Vpurify_flag);
+#endif
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
+ if (use_loadpath && egetenv ("EMACSLOADPATH"))
+ {
+ Vload_path = decode_env_path ("EMACSLOADPATH", 0, 1);
- if (!no_site_lisp)
- {
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vsource_directory);
- tem1 = Ffile_accessible_directory_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- }
- } /* Vinstallation_directory != Vsource_directory */
+ /* Check (non-nil) user-supplied elements. */
+ load_path_check (Vload_path);
- } /* if Vinstallation_directory */
+ /* If no nils in the environment variable, use as-is.
+ Otherwise, replace any nils with the default. */
+ if (! NILP (Fmemq (Qnil, Vload_path)))
+ {
+ Lisp_Object elem, elpath = Vload_path;
+ Lisp_Object default_lpath = load_path_default ();
- /* Check before adding the site-lisp directories.
- The install should have created them, but they are not
- required, so no need to warn if they are absent.
- Or we might be running before installation. */
- load_path_check ();
+ /* Check defaults, before adding site-lisp. */
+ load_path_check (default_lpath);
- /* Add the site-lisp directories at the front. */
+ /* Add the site-lisp directories to the front of the default. */
if (!no_site_lisp)
{
Lisp_Object sitelisp;
- sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
- if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
+ if (! NILP (sitelisp))
+ default_lpath = nconc2 (sitelisp, default_lpath);
}
- } /* if dump_path == Vload_path */
+
+ Vload_path = Qnil;
+
+ /* Replace nils from EMACSLOADPATH by default. */
+ while (CONSP (elpath))
+ {
+ Lisp_Object arg[2];
+ elem = XCAR (elpath);
+ elpath = XCDR (elpath);
+ arg[0] = Vload_path;
+ arg[1] = NILP (elem) ? default_lpath : Fcons (elem, Qnil);
+ Vload_path = Fappend (2, arg);
+ }
+ } /* Fmemq (Qnil, Vload_path) */
}
- else /* !initialized */
+ else
{
- /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the
- source directory. We used to add ../lisp (ie the lisp dir in
- the build directory) at the front here, but that caused trouble
- because it was copied from dump_path into Vload_path, above,
- when Vinstallation_directory was non-nil. It should not be
- necessary, since in out of tree builds lisp/ is empty, save
- for Makefile. */
- Vload_path = decode_env_path (0, normal);
- dump_path = Vload_path;
- /* No point calling load_path_check; load-path only contains essential
- elements from the source directory at this point. They cannot
- be missing unless something went extremely (and improbably)
- wrong, in which case the build will fail in obvious ways. */
+ Vload_path = load_path_default ();
+
+ /* Check before adding site-lisp directories.
+ The install should have created them, but they are not
+ required, so no need to warn if they are absent.
+ Or we might be running before installation. */
+ load_path_check (Vload_path);
+
+ /* Add the site-lisp directories at the front. */
+ if (initialized && !no_site_lisp)
+ {
+ Lisp_Object sitelisp;
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
+ if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ }
}
-#endif /* !CANNOT_DUMP */
Vvalues = Qnil;
void
syms_of_lread (void)
{
- defsubr (&Sread);
- defsubr (&Sread_from_string);
- defsubr (&Sintern);
- defsubr (&Sintern_soft);
- defsubr (&Sunintern);
- defsubr (&Sget_load_suffixes);
- defsubr (&Sload);
- defsubr (&Seval_buffer);
- defsubr (&Seval_region);
- defsubr (&Sread_char);
- defsubr (&Sread_char_exclusive);
- defsubr (&Sread_event);
- defsubr (&Sget_file_char);
- defsubr (&Smapatoms);
- defsubr (&Slocate_file_internal);
+#include "lread.x"
DEFVAR_LISP ("obarray", Vobarray,
doc: /* Symbol table for use by `intern' and `read'.
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological. */);
- XSYMBOL (intern ("values"))->declared_special = 0;
+ SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (intern ("values")), 0);
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
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).
-Initialized based on EMACSLOADPATH environment variable, if any,
-otherwise to default specified by file `epaths.h' when Emacs was built. */);
+Each element is a string (directory name) or nil (meaning `default-directory').
+Initialized during startup as described in Info node `(elisp)Library Search'. */);
DEFVAR_LISP ("load-suffixes", Vload_suffixes,
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_pure_c_string (".elc"),
- Fcons (build_pure_c_string (".el"), Qnil));
+ Vload_suffixes = list2 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
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. */);
- Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
+ Vload_file_rep_suffixes = list1 (empty_unibyte_string);
DEFVAR_BOOL ("load-in-progress", load_in_progress,
doc: /* Non-nil if inside of `load'. */);
You cannot count on them to still be there! */);
Vsource_directory
= Fexpand_file_name (build_string ("../"),
- Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
+ Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0)));
DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list,
doc: /* List of files that were preloaded (when dumping Emacs). */);
Vold_style_backquotes = Qnil;
DEFSYM (Qold_style_backquotes, "old-style-backquotes");
+ DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer,
+ doc: /* Non-nil means `load' prefers the newest version of a file.
+This applies when a filename suffix is not explicitly specified and
+`load' is trying various possible suffixes (see `load-suffixes' and
+`load-file-rep-suffixes'). Normally, it stops at the first file
+that exists unless you explicitly specify one or the other. If this
+option is non-nil, it checks all suffixes and uses whichever file is
+newest.
+Note that if you customize this, obviously it will not affect files
+that are loaded before your customizations are read! */);
+ load_prefer_newer = 1;
+
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");
DEFSYM (Qdir_ok, "dir-ok");
DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
- staticpro (&dump_path);
-
staticpro (&read_objects);
read_objects = Qnil;
staticpro (&seen_list);
HCoop / bpt / emacs.git / blobdiff