#include "buffer.h"
#include "bytecode.h"
-#include "elhash.h"
+#include "commands.h"
+#include "insdel.h"
#include "lstream.h"
#include "opaque.h"
+#include <paths.h>
#ifdef FILE_CODING
#include "file-coding.h"
#endif
Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
Lisp_Object Qcurrent_load_list;
Lisp_Object Qload, Qload_file_name;
+Lisp_Object Qlocate_file_hash_table;
Lisp_Object Qfset;
-/* Hash-table that maps directory names to hashes of their contents. */
-static Lisp_Object Vlocate_file_hash_table;
-
-Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
-
/* See read_escape() for an explanation of this. */
#if 0
int fail_on_bucky_bit_character_escapes;
/* Whether Fload_internal() should ignore .elc files when no suffix is given */
int load_ignore_elc_files;
+/* Directory in which the sources were found. */
+Lisp_Object Vsource_directory;
+
/* Search path for files to be loaded. */
Lisp_Object Vload_path;
Each member of the list has the form (n . object), and is used to
look up the object for the corresponding #n# construct.
It must be set to nil before all top-level calls to read0. */
-Lisp_Object Vread_objects;
+Lisp_Object read_objects;
/* Nonzero means load should forcibly load all dynamic doc strings. */
/* Note that this always happens (with some special behavior) when
\f
static DOESNT_RETURN
-read_syntax_error (const char *string)
+syntax_error (CONST char *string)
{
signal_error (Qinvalid_read_syntax,
list1 (build_translated_string (string)));
}
static Lisp_Object
-continuable_read_syntax_error (const char *string)
+continuable_syntax_error (CONST char *string)
{
return Fsignal (Qinvalid_read_syntax,
list1 (build_translated_string (string)));
Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
#ifdef DEBUG_XEMACS /* testing Mule */
static int testing_mule = 0; /* Change via debugger */
- if (testing_mule)
- {
- if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
- else if (c == '\n') stderr_out ("\\n\n");
- else stderr_out ("\\%o ", c);
- }
-#endif /* testing Mule */
+ if (testing_mule) {
+ if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
+ else if (c == '\n') fprintf (stderr, "\\n\n");
+ else fprintf (stderr, "\\%o ", c);
+ }
+#endif
return c;
}
else if (MARKERP (readcharfun))
something to `funcall', but who would really do that? As
they say in law, we've made a "good-faith effort" to
unfuckify ourselves. And doing it this way avoids screwing
- up args to `make-hash-table' and such. As it is, we have to
+ up args to `make-hashtable' and such. As it is, we have to
add an extra Ebola check in decode_weak_list_type(). --ben */
- if (EQ (el, Qassoc)) el = Qold_assoc;
- else if (EQ (el, Qdelq)) el = Qold_delq;
+ if (EQ (el, Qassoc))
+ el = Qold_assoc;
+ if (EQ (el, Qdelq))
+ el = Qold_delq;
#if 0
/* I think this is a bad idea because it will probably mess
with keymap code. */
- else if (EQ (el, Qdelete)) el = Qold_delete;
+ if (EQ (el, Qdelete))
+ el = Qold_delete;
#endif
- else if (EQ (el, Qrassq)) el = Qold_rassq;
- else if (EQ (el, Qrassoc)) el = Qold_rassoc;
-
+ if (EQ (el, Qrassq))
+ el = Qold_rassq;
+ if (EQ (el, Qrassoc))
+ el = Qold_rassoc;
XVECTOR_DATA (vector)[i] = el;
}
}
Lisp_Object list = Vload_force_doc_string_list;
Lisp_Object tail;
int fd = XINT (XCAR (Vload_descriptor_list));
+ /* NOTE: If purify_flag is true, we're in-place modifying objects that
+ may be in purespace (and if not, they will be). Therefore, we have
+ to be VERY careful to make sure that all objects that we create
+ are purecopied -- objects in purespace are not marked for GC, and
+ if we leave any impure objects inside of pure ones, we're really
+ screwed. */
GCPRO1 (list);
/* restore the old value first just in case an error occurs. */
Lisp_Object doc;
assert (COMPILED_FUNCTIONP (john));
- if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
+ if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes))
{
struct gcpro ngcpro1;
Lisp_Object juan = (pas_de_lache_ici
- (fd, XCOMPILED_FUNCTION (john)->instructions));
+ (fd, XCOMPILED_FUNCTION (john)->bytecodes));
Lisp_Object ivan;
NGCPRO1 (juan);
ivan = Fread (juan);
if (!CONSP (ivan))
signal_simple_error ("invalid lazy-loaded byte code", ivan);
- XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
+ /* Remember to purecopy; see above. */
+ XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan));
/* v18 or v19 bytecode file. Need to Ebolify. */
if (XCOMPILED_FUNCTION (john)->flags.ebolified
&& VECTORP (XCDR (ivan)))
ebolify_bytecode_constants (XCDR (ivan));
- XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
+ XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
NUNGCPRO;
}
doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
general be different from CODESYS if CODESYS specifies automatic
encoding detection or end-of-line detection.
*/
- (file, noerror, nomessage, nosuffix, codesys, used_codesys))
+ (file, no_error, nomessage, nosuffix, codesys, used_codesys))
{
/* This function can GC */
int fd = -1;
int message_p = NILP (nomessage);
/*#ifdef DEBUG_XEMACS*/
static Lisp_Object last_file_loaded;
+ size_t pure_usage = 0;
/*#endif*/
struct stat s1, s2;
GCPRO3 (file, newer, found);
{
message_p = 1;
last_file_loaded = file;
+ pure_usage = purespace_usage ();
}
/*#endif / * DEBUG_XEMACS */
/* If file name is magic, call the handler. */
handler = Ffind_file_name_handler (file, Qload);
if (!NILP (handler))
- RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,
+ RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
nomessage, nosuffix));
/* Do this after the handler to avoid
int foundlen;
fd = locate_file (Vload_path, file,
- ((!NILP (nosuffix)) ? Qnil :
- build_string (load_ignore_elc_files ? ".el:" :
- ".elc:.el:")),
+ ((!NILP (nosuffix)) ? "" :
+ load_ignore_elc_files ? ".el:" :
+ ".elc:.el:"),
&found,
-1);
if (fd < 0)
{
- if (NILP (noerror))
+ if (NILP (no_error))
signal_file_error ("Cannot open load file", file);
else
{
int result;
/* temporarily hack the 'c' off the end of the filename */
foundstr[foundlen - 1] = '\0';
- result = xemacs_stat (foundstr, &s2);
+ result = stat (foundstr, &s2);
if (result >= 0 &&
(unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
{
{
/* Lisp_Object's must be malloc'ed, not stack-allocated */
Lisp_Object lispstream = Qnil;
- const int block_size = 8192;
+ CONST int block_size = 8192;
struct gcpro ngcpro1;
NGCPRO1 (lispstream);
/*#ifdef DEBUG_XEMACS*/
if (purify_flag && noninteractive)
{
- if (!EQ (last_file_loaded, file))
- message ("Loading %s ...done", XSTRING_DATA (file));
+ if (EQ (last_file_loaded, file))
+ message_append (" (%d)", purespace_usage() - pure_usage);
+ else
+ message ("Loading %s ...done (%d)", XSTRING_DATA (file),
+ purespace_usage() - pure_usage);
}
/*#endif / * DEBUG_XEMACS */
}
\f
-/* ------------------------------- */
-/* locate_file */
-/* ------------------------------- */
-
-static int
-decode_mode_1 (Lisp_Object mode)
-{
- if (EQ (mode, Qexists))
- return F_OK;
- else if (EQ (mode, Qexecutable))
- return X_OK;
- else if (EQ (mode, Qwritable))
- return W_OK;
- else if (EQ (mode, Qreadable))
- return R_OK;
- else if (INTP (mode))
- {
- check_int_range (XINT (mode), 0, 7);
- return XINT (mode);
- }
- else
- signal_simple_error ("Invalid value", mode);
- return 0; /* unreached */
-}
-
+#if 0 /* FSFmacs */
+/* not used */
static int
-decode_mode (Lisp_Object mode)
+complete_filename_p (Lisp_Object pathname)
{
- if (NILP (mode))
- return R_OK;
- else if (CONSP (mode))
- {
- Lisp_Object tail;
- int mask = 0;
- EXTERNAL_LIST_LOOP (tail, mode)
- mask |= decode_mode_1 (XCAR (tail));
- return mask;
- }
- else
- return decode_mode_1 (mode);
+ REGISTER unsigned char *s = XSTRING_DATA (pathname);
+ return (IS_DIRECTORY_SEP (s[0])
+ || (XSTRING_LENGTH (pathname) > 2
+ && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
+#ifdef ALTOS
+ || *s == '@'
+#endif
+ );
}
+#endif /* 0 */
DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
-Search for FILENAME through PATH-LIST.
-
-If SUFFIXES is non-nil, it should be a list of suffixes to append to
-file name when searching.
-
-If MODE is non-nil, it should be a symbol or a list of symbol representing
-requirements. Allowed symbols are `exists', `executable', `writable', and
-`readable'. If MODE is nil, it defaults to `readable'.
+Search for FILENAME through PATH-LIST, expanded by one of the optional
+SUFFIXES (string of suffixes separated by ":"s), checking for access
+MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
`locate-file' keeps hash tables of the directories it searches through,
in order to speed things up. It tries valiantly to not get confused in
Lisp_Object tp;
CHECK_STRING (filename);
-
- if (LISTP (suffixes))
- {
- Lisp_Object tail;
- EXTERNAL_LIST_LOOP (tail, suffixes)
- CHECK_STRING (XCAR (tail));
- }
- else
+ if (!NILP (suffixes))
CHECK_STRING (suffixes);
+ if (!NILP (mode))
+ CHECK_NATNUM (mode);
- locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
+ locate_file (path_list, filename,
+ ((NILP (suffixes)) ? "" :
+ (char *) (XSTRING_DATA (suffixes))),
+ &tp, (NILP (mode) ? R_OK : XINT (mode)));
return tp;
}
-/* Recalculate the hash table for the given string. DIRECTORY should
- better have been through Fexpand_file_name() by now. */
+/* recalculate the hash table for the given string */
static Lisp_Object
-locate_file_refresh_hashing (Lisp_Object directory)
+locate_file_refresh_hashing (Lisp_Object str)
{
Lisp_Object hash =
- make_directory_hash_table ((char *) XSTRING_DATA (directory));
-
- if (!NILP (hash))
- Fputhash (directory, hash, Vlocate_file_hash_table);
+ make_directory_hash_table ((char *) XSTRING_DATA (str));
+ Fput (str, Qlocate_file_hash_table, hash);
return hash;
}
-/* find the hash table for the given directory, recalculating if necessary */
+/* find the hash table for the given string, recalculating if necessary */
static Lisp_Object
-locate_file_find_directory_hash_table (Lisp_Object directory)
-{
- Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
- if (NILP (hash))
- return locate_file_refresh_hashing (directory);
- else
- return hash;
-}
-
-/* The SUFFIXES argument in any of the locate_file* functions can be
- nil, a list, or a string (for backward compatibility), with the
- following semantics:
-
- a) nil - no suffix, just search for file name intact
- (semantically different from "empty suffix list", which
- would be meaningless.)
- b) list - list of suffixes to append to file name. Each of these
- must be a string.
- c) string - colon-separated suffixes to append to file name (backward
- compatibility).
-
- All of this got hairy, so I decided to use a mapper. Calling a
- function for each suffix shouldn't slow things down, since
- locate_file is rarely called with enough suffixes for funcalls to
- make any difference. */
-
-/* Map FUN over SUFFIXES, as described above. FUN will be called with a
- char * containing the current file name, and ARG. Mapping stops when
- FUN returns non-zero. */
-static void
-locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
- int (*fun) (char *, void *),
- void *arg)
+locate_file_find_directory_hash_table (Lisp_Object str)
{
- /* This function can GC */
- char *fn;
- int fn_len, max;
-
- /* Calculate maximum size of any filename made from
- this path element/specified file name and any possible suffix. */
- if (CONSP (suffixes))
- {
- /* We must traverse the list, so why not do it right. */
- Lisp_Object tail;
- max = 0;
- LIST_LOOP (tail, suffixes)
- {
- if (XSTRING_LENGTH (XCAR (tail)) > max)
- max = XSTRING_LENGTH (XCAR (tail));
- }
- }
- else if (NILP (suffixes))
- max = 0;
- else
- /* Just take the easy way out */
- max = XSTRING_LENGTH (suffixes);
-
- fn_len = XSTRING_LENGTH (filename);
- fn = (char *) alloca (max + fn_len + 1);
- memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
-
- /* Loop over suffixes. */
- if (!STRINGP (suffixes))
- {
- if (NILP (suffixes))
- {
- /* Case a) discussed in the comment above. */
- fn[fn_len] = 0;
- if ((*fun) (fn, arg))
- return;
- }
- else
- {
- /* Case b) */
- Lisp_Object tail;
- LIST_LOOP (tail, suffixes)
- {
- memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
- XSTRING_LENGTH (XCAR (tail)));
- fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
- if ((*fun) (fn, arg))
- return;
- }
- }
- }
- else
- {
- /* Case c) */
- const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
-
- while (1)
- {
- char *esuffix = (char *) strchr (nsuffix, ':');
- int lsuffix = esuffix ? esuffix - nsuffix : (int) strlen (nsuffix);
-
- /* Concatenate path element/specified name with the suffix. */
- strncpy (fn + fn_len, nsuffix, lsuffix);
- fn[fn_len + lsuffix] = 0;
-
- if ((*fun) (fn, arg))
- return;
-
- /* Advance to next suffix. */
- if (esuffix == 0)
- break;
- nsuffix += lsuffix + 1;
- }
- }
-}
-
-struct locate_file_in_directory_mapper_closure {
- int fd;
- Lisp_Object *storeptr;
- int mode;
-};
-
-static int
-locate_file_in_directory_mapper (char *fn, void *arg)
-{
- struct locate_file_in_directory_mapper_closure *closure =
- (struct locate_file_in_directory_mapper_closure *)arg;
- struct stat st;
-
- /* Ignore file if it's a directory. */
- if (xemacs_stat (fn, &st) >= 0
- && (st.st_mode & S_IFMT) != S_IFDIR)
- {
- /* Check that we can access or open it. */
- if (closure->mode >= 0)
- closure->fd = access (fn, closure->mode);
- else
- closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
-
- if (closure->fd >= 0)
- {
- /* We succeeded; return this descriptor and filename. */
- if (closure->storeptr)
- *closure->storeptr = build_string (fn);
-
-#ifndef WIN32_NATIVE
- /* If we actually opened the file, set close-on-exec flag
- on the new descriptor so that subprocesses can't whack
- at it. */
- if (closure->mode < 0)
- (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
-#endif
-
- return 1;
- }
- }
- /* Keep mapping. */
- return 0;
+ Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
+ if (NILP (Fhashtablep (hash)))
+ return locate_file_refresh_hashing (str);
+ return hash;
}
-
-/* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
- not have been expanded. */
+/* look for STR in PATH, optionally adding suffixes in SUFFIX */
static int
-locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
- Lisp_Object suffixes, Lisp_Object *storeptr,
+locate_file_in_directory (Lisp_Object path, Lisp_Object str,
+ CONST char *suffix, Lisp_Object *storeptr,
int mode)
{
/* This function can GC */
- struct locate_file_in_directory_mapper_closure closure;
+ int fd;
+ int fn_size = 100;
+ char buf[100];
+ char *fn = buf;
+ int want_size;
+ struct stat st;
Lisp_Object filename = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
+ CONST char *nsuffix;
- GCPRO3 (directory, str, filename);
+ GCPRO3 (path, str, filename);
- filename = Fexpand_file_name (str, directory);
+ filename = Fexpand_file_name (str, path);
if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
/* If there are non-absolute elts in PATH (eg ".") */
/* Of course, this could conceivably lose if luser sets
default-directory to be something non-absolute ... */
{
if (NILP (filename))
- /* NIL means current directory */
+ /* NIL means current dirctory */
filename = current_buffer->directory;
else
filename = Fexpand_file_name (filename,
current_buffer->directory);
if (NILP (Ffile_name_absolute_p (filename)))
{
- /* Give up on this directory! */
+ /* Give up on this path element! */
UNGCPRO;
return -1;
}
}
+ /* Calculate maximum size of any filename made from
+ this path element/specified file name and any possible suffix. */
+ want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
+ if (fn_size < want_size)
+ fn = (char *) alloca (fn_size = 100 + want_size);
+
+ nsuffix = suffix;
+
+ /* Loop over suffixes. */
+ while (1)
+ {
+ char *esuffix = (char *) strchr (nsuffix, ':');
+ int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
+
+ /* Concatenate path element/specified name with the suffix. */
+ strncpy (fn, (char *) XSTRING_DATA (filename),
+ XSTRING_LENGTH (filename));
+ fn[XSTRING_LENGTH (filename)] = 0;
+ if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
+ strncat (fn, nsuffix, lsuffix);
+
+ /* Ignore file if it's a directory. */
+ if (stat (fn, &st) >= 0
+ && (st.st_mode & S_IFMT) != S_IFDIR)
+ {
+ /* Check that we can access or open it. */
+ if (mode >= 0)
+ fd = access (fn, mode);
+ else
+ fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
- closure.fd = -1;
- closure.storeptr = storeptr;
- closure.mode = mode;
+ if (fd >= 0)
+ {
+ /* We succeeded; return this descriptor and filename. */
+ if (storeptr)
+ *storeptr = build_string (fn);
+ UNGCPRO;
- locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
- &closure);
+#ifndef WINDOWSNT
+ /* If we actually opened the file, set close-on-exec flag
+ on the new descriptor so that subprocesses can't whack
+ at it. */
+ if (mode < 0)
+ (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
+#endif
+
+ return fd;
+ }
+ }
+
+ /* Advance to next suffix. */
+ if (esuffix == 0)
+ break;
+ nsuffix += lsuffix + 1;
+ }
UNGCPRO;
- return closure.fd;
+ return -1;
}
/* do the same as locate_file() but don't use any hash tables. */
static int
locate_file_without_hash (Lisp_Object path, Lisp_Object str,
- Lisp_Object suffixes, Lisp_Object *storeptr,
+ CONST char *suffix, Lisp_Object *storeptr,
int mode)
{
/* This function can GC */
- int absolute = !NILP (Ffile_name_absolute_p (str));
+ int absolute;
+ struct gcpro gcpro1;
- EXTERNAL_LIST_LOOP (path, path)
+ /* is this necessary? */
+ GCPRO1 (path);
+
+ absolute = !NILP (Ffile_name_absolute_p (str));
+
+ for (; !NILP (path); path = Fcdr (path))
{
- int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
- mode);
+ int val = locate_file_in_directory (Fcar (path), str, suffix,
+ storeptr, mode);
if (val >= 0)
- return val;
+ {
+ UNGCPRO;
+ return val;
+ }
if (absolute)
break;
}
- return -1;
-}
-static int
-locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
-{
- Lisp_Object *tail = (Lisp_Object *)arg;
- *tail = Fcons (build_string (fn), *tail);
- return 0;
+ UNGCPRO;
+ return -1;
}
-/* Construct a list of all files to search for.
- It makes sense to have this despite locate_file_map_suffixes()
- because we need Lisp strings to access the hash-table, and it would
- be inefficient to create them on the fly, again and again for each
- path component. See locate_file(). */
+/* Construct a list of all files to search for. */
static Lisp_Object
-locate_file_construct_suffixed_files (Lisp_Object filename,
- Lisp_Object suffixes)
+locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
{
- Lisp_Object tail = Qnil;
- struct gcpro gcpro1;
- GCPRO1 (tail);
+ int want_size;
+ int fn_size = 100;
+ char buf[100];
+ char *fn = buf;
+ CONST char *nsuffix;
+ Lisp_Object suffixtab = Qnil;
- locate_file_map_suffixes (filename, suffixes,
- locate_file_construct_suffixed_files_mapper,
- &tail);
+ /* Calculate maximum size of any filename made from
+ this path element/specified file name and any possible suffix. */
+ want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1;
+ if (fn_size < want_size)
+ fn = (char *) alloca (fn_size = 100 + want_size);
- UNGCPRO;
- return Fnreverse (tail);
+ nsuffix = suffix;
+
+ while (1)
+ {
+ char *esuffix = (char *) strchr (nsuffix, ':');
+ int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
+
+ /* Concatenate path element/specified name with the suffix. */
+ strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str));
+ fn[XSTRING_LENGTH (str)] = 0;
+ if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
+ strncat (fn, nsuffix, lsuffix);
+
+ suffixtab = Fcons (build_string (fn), suffixtab);
+ /* Advance to next suffix. */
+ if (esuffix == 0)
+ break;
+ nsuffix += lsuffix + 1;
+ }
+ return Fnreverse (suffixtab);
}
DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
`locate-file' will primarily get confused if you add a file that shadows
\(i.e. has the same name as) another file further down in the directory list.
In this case, you must call `locate-file-clear-hashing'.
-
-If PATH is t, it means to fully clear all the accumulated hashes. This
-can be used if the internal tables grow too large, or when dumping.
*/
(path))
{
- if (EQ (path, Qt))
- Fclrhash (Vlocate_file_hash_table);
- else
+ Lisp_Object pathtail;
+
+ for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
{
- Lisp_Object pathtail;
- EXTERNAL_LIST_LOOP (pathtail, path)
- {
- Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
- Fremhash (pathel, Vlocate_file_hash_table);
- }
+ Lisp_Object pathel = Fcar (pathtail);
+ if (!purified (pathel))
+ Fput (pathel, Qlocate_file_hash_table, Qnil);
}
return Qnil;
}
/* Search for a file whose name is STR, looking in directories
- in the Lisp list PATH, and trying suffixes from SUFFIXES.
- SUFFIXES is a list of possible suffixes, or (for backward
- compatibility) a string containing possible suffixes separated by
- colons.
+ in the Lisp list PATH, and trying suffixes from SUFFIX.
+ SUFFIX is a string containing possible suffixes separated by colons.
On success, returns a file descriptor. On failure, returns -1.
MODE nonnegative means don't open the files,
Called openp() in FSFmacs. */
int
-locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
+locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
Lisp_Object *storeptr, int mode)
{
/* This function can GC */
Lisp_Object suffixtab = Qnil;
- Lisp_Object pathtail, pathel_expanded;
+ Lisp_Object pathtail;
int val;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2, gcpro3;
if (storeptr)
*storeptr = Qnil;
- /* Is it really necessary to gcpro path and str? It shouldn't be
- unless some caller has fucked up. There are known instances that
- call us with build_string("foo:bar") as SUFFIXES, though. */
- GCPRO4 (path, str, suffixes, suffixtab);
-
/* if this filename has directory components, it's too complicated
to try and use the hash tables. */
if (!NILP (Ffile_name_directory (str)))
- {
- val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
- UNGCPRO;
- return val;
- }
+ return locate_file_without_hash (path, str, suffix, storeptr,
+ mode);
- suffixtab = locate_file_construct_suffixed_files (str, suffixes);
+ /* Is it really necessary to gcpro path and str? It shouldn't be
+ unless some caller has fucked up. */
+ GCPRO3 (path, str, suffixtab);
+
+ suffixtab = locate_file_construct_suffixed_files (str, suffix);
- EXTERNAL_LIST_LOOP (pathtail, path)
+ for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
{
- Lisp_Object pathel = XCAR (pathtail);
- Lisp_Object hash_table;
+ Lisp_Object pathel = Fcar (pathtail);
+ Lisp_Object hashtab;
Lisp_Object tail;
- int found = 0;
+ int found;
- /* If this path element is relative, we have to look by hand. */
- if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
+ /* If this path element is relative, we have to look by hand.
+ Can't set string property in a pure string. */
+ if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
+ purified (pathel))
{
- val = locate_file_in_directory (pathel, str, suffixes, storeptr,
+ val = locate_file_in_directory (pathel, str, suffix, storeptr,
mode);
if (val >= 0)
{
continue;
}
- pathel_expanded = Fexpand_file_name (pathel, Qnil);
- hash_table = locate_file_find_directory_hash_table (pathel_expanded);
+ hashtab = locate_file_find_directory_hash_table (pathel);
- if (!NILP (hash_table))
+ /* Loop over suffixes. */
+ for (tail = suffixtab, found = 0; !found && CONSP (tail);
+ tail = XCDR (tail))
{
- /* Loop over suffixes. */
- LIST_LOOP (tail, suffixtab)
- if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
- {
- found = 1;
- break;
- }
+ if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil)))
+ found = 1;
}
if (found)
{
/* This is a likely candidate. Look by hand in this directory
so we don't get thrown off if someone byte-compiles a file. */
- val = locate_file_in_directory (pathel, str, suffixes, storeptr,
+ val = locate_file_in_directory (pathel, str, suffix, storeptr,
mode);
if (val >= 0)
{
/* Hmm ... the file isn't actually there. (Or possibly it's
a directory ...) So refresh our hashing. */
- locate_file_refresh_hashing (pathel_expanded);
+ locate_file_refresh_hashing (pathel);
}
}
/* File is probably not there, but check the hard way just in case. */
- val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
+ val = locate_file_without_hash (path, str, suffix, storeptr,
+ mode);
if (val >= 0)
{
/* Sneaky user added a file without telling us. */
{
/* This function can GC */
REGISTER Emchar c;
- REGISTER Lisp_Object val = Qnil;
+ REGISTER Lisp_Object val;
int speccount = specpdl_depth ();
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1;
struct buffer *b = 0;
if (BUFFERP (readcharfun))
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
Vcurrent_compiled_function_annotation = Qnil;
#endif
- GCPRO2 (val, sourcename);
+ GCPRO1 (sourcename);
LOADHIST_ATTACH (sourcename);
#else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
{
unreadchar (readcharfun, c);
- Vread_objects = Qnil;
+ read_objects = Qnil;
if (NILP (Vload_read_function))
val = read0 (readcharfun);
else
Programs can pass two arguments, BUFFER and PRINTFLAG.
BUFFER is the buffer to evaluate (nil means use current buffer).
PRINTFLAG controls printing of output:
-nil means discard it; anything else is a stream for printing.
+nil means discard it; anything else is stream for print.
If there is no error, point does not move. If there is an error,
point remains at the end of the last character read from the buffer.
+Execute BUFFER as Lisp code.
*/
- (buffer, printflag))
+ (bufname, printflag))
{
/* This function can GC */
int speccount = specpdl_depth ();
Lisp_Object tem, buf;
- if (NILP (buffer))
+ if (NILP (bufname))
buf = Fcurrent_buffer ();
else
- buf = Fget_buffer (buffer);
+ buf = Fget_buffer (bufname);
if (NILP (buf))
error ("No such buffer.");
DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
Execute the region as Lisp code.
-When called from programs, expects two arguments START and END
+When called from programs, expects two arguments,
giving starting and ending indices in the current buffer
of the text to be executed.
-Programs can pass third optional argument STREAM which controls output:
+Programs can pass third argument PRINTFLAG which controls output:
nil means discard it; anything else is stream for printing it.
If there is no error, point does not move. If there is an error,
If the code being eval'd should happen to trigger a redisplay you may
see some text temporarily disappear because of this.
*/
- (start, end, stream))
+ (b, e, printflag))
{
/* This function can GC */
int speccount = specpdl_depth ();
Lisp_Object tem;
Lisp_Object cbuf = Fcurrent_buffer ();
- if (NILP (stream))
+ if (NILP (printflag))
tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
else
- tem = stream;
+ tem = printflag;
specbind (Qstandard_output, tem);
- if (NILP (stream))
+ 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, cbuf);
- Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
+ /* This both uses b and checks its type. */
+ Fgoto_char (b, cbuf);
+ Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
- !NILP (stream));
+ !NILP (printflag));
return unbind_to (speccount, Qnil);
}
if (EQ (stream, Qt))
stream = Qread_char;
- Vread_objects = Qnil;
+ read_objects = Qnil;
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
Vcurrent_compiled_function_annotation = Qnil;
lispstream = make_lisp_string_input_stream (string, startval,
endval - startval);
- Vread_objects = Qnil;
+ read_objects = Qnil;
tem = read0 (lispstream);
/* Yeah, it's ugly. Gonna make something of it?
static Lisp_Object
read0 (Lisp_Object readcharfun)
{
- Lisp_Object val = read1 (readcharfun);
+ Lisp_Object val;
+ val = read1 (readcharfun);
if (CONSP (val) && UNBOUNDP (XCAR (val)))
{
Emchar c = XCHAR (XCDR (val));
}
case 'x':
- /* A hex escape, as in ANSI C, except that we only allow latin-1
- characters to be read this way. What is "\x4e03" supposed to
- mean, anyways, if the internal representation is hidden?
- This is also consistent with the treatment of octal escapes. */
+ /* A hex escape, as in ANSI C. */
{
REGISTER Emchar i = 0;
- REGISTER int count = 0;
- while (++count <= 2)
+ while (1)
{
c = readchar (readcharfun);
/* Remember, can't use isdigit(), isalpha() etc. on Emchars */
return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
}
-static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);
+static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
static Lisp_Object
read_atom (Lisp_Object readcharfun,
{
Lisp_Object sym;
if (uninterned_symbol)
- sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
+ sym = (Fmake_symbol ((purify_flag)
+ ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
+ : make_string ((Bufbyte *) read_ptr, len)));
else
{
+ /* intern will purecopy pname if necessary */
Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
sym = Fintern (name, Qnil);
+
+ if (SYMBOL_IS_KEYWORD (sym))
+ {
+ /* the LISP way is to put keywords in their own package,
+ but we don't have packages, so we do something simpler.
+ Someday, maybe we'll have packages and then this will
+ be reworked. --Stig. */
+ XSYMBOL (sym)->value = sym;
+ }
}
return sym;
}
static Lisp_Object
-parse_integer (const Bufbyte *buf, Bytecount len, int base)
+parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
{
- const Bufbyte *lim = buf + len;
- const Bufbyte *p = buf;
+ CONST Bufbyte *lim = buf + len;
+ CONST Bufbyte *p = buf;
EMACS_UINT num = 0;
int negativland = 0;
read_bit_vector (Lisp_Object readcharfun)
{
unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
- Lisp_Object val;
+ Emchar c;
while (1)
{
- unsigned char bit;
- Emchar c = readchar (readcharfun);
- if (c == '0')
- bit = 0;
- else if (c == '1')
- bit = 1;
- else
- {
- if (c >= 0)
- unreadchar (readcharfun, c);
- break;
- }
- Dynarr_add (dyn, bit);
+ c = readchar (readcharfun);
+ if (c != '0' && c != '1')
+ break;
+ Dynarr_add (dyn, (unsigned char) (c - '0'));
}
- val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
- Dynarr_length (dyn));
- Dynarr_free (dyn);
+ if (c >= 0)
+ unreadchar (readcharfun, c);
- return val;
+ return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+ Dynarr_length (dyn));
}
\f
GCPRO2 (orig_list, already_seen);
if (c != '(')
- RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
+ RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
list = read_list (readcharfun, ')', 0, 0);
orig_list = list;
{
int len = XINT (Flength (list));
if (len == 0)
- RETURN_UNGCPRO (continuable_read_syntax_error
+ RETURN_UNGCPRO (continuable_syntax_error
("structure type not specified"));
if (!(len & 1))
RETURN_UNGCPRO
- (continuable_read_syntax_error
+ (continuable_syntax_error
("structures must have alternating keyword/value pairs"));
}
case '+':
case '-':
{
- Lisp_Object feature_exp, obj, tem;
+ Lisp_Object fexp, obj, tem;
struct gcpro gcpro1, gcpro2;
- feature_exp = read0(readcharfun);
+ fexp = read0(readcharfun);
obj = read0(readcharfun);
/* the call to `featurep' may GC. */
- GCPRO2 (feature_exp, obj);
- tem = call1 (Qfeaturep, feature_exp);
+ GCPRO2(fexp, obj);
+ tem = call1(Qfeaturep, fexp);
UNGCPRO;
- if (c == '+' && NILP(tem)) goto retry;
+ if (c == '+' && NILP(tem)) goto retry;
if (c == '-' && !NILP(tem)) goto retry;
return obj;
}
n += c - '0';
c = readchar (readcharfun);
}
- found = assq_no_quit (make_int (n), Vread_objects);
+ found = assq_no_quit (make_int (n), read_objects);
if (c == '=')
{
/* #n=object returns object, but associates it with
("Multiply defined symbol label"),
make_int (n)));
obj = read0 (readcharfun);
- Vread_objects = Fcons (Fcons (make_int (n), obj),
- Vread_objects);
+ read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
return obj;
}
else if (c == '#')
return Qzero;
Lstream_flush (XLSTREAM (Vread_buffer_stream));
- return
- make_string
- (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
- Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
+#if 0 /* FSFmacs defun hack */
+ if (read_pure)
+ return
+ make_pure_string
+ (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
+ else
+#endif
+ return
+ make_string
+ (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
}
default:
#define EXP_INT 16
int
-isfloat_string (const char *cp)
+isfloat_string (CONST char *cp)
{
int state = 0;
- const Bufbyte *ucp = (const Bufbyte *) cp;
+ CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
if (*ucp == '+' || *ucp == '-')
ucp++;
unreadchar (readcharfun, ch);
#ifdef FEATUREP_SYNTAX
if (ch == ']')
- read_syntax_error ("\"]\" in a list");
+ syntax_error ("\"]\" in a list");
else if (ch == ')')
- read_syntax_error ("\")\" in a vector");
+ syntax_error ("\")\" in a vector");
#endif
state = ((conser) (readcharfun, state, len));
}
goto done;
}
else if (ch == ']')
- read_syntax_error ("']' in a list");
+ syntax_error ("']' in a list");
else if (ch == ')')
- read_syntax_error ("')' in a vector");
+ syntax_error ("')' in a vector");
else
#endif
if (ch != '.')
signal_simple_error ("BUG! Internal reader error", elt);
else if (!s->allow_dotted_lists)
- read_syntax_error ("\".\" in a vector");
+ syntax_error ("\".\" in a vector");
else
{
if (!NILP (s->tail))
goto done;
}
}
- read_syntax_error (". in wrong context");
+ syntax_error (". in wrong context");
}
}
i < len;
i++, p++)
{
- Lisp_Cons *otem = XCONS (tem);
- tem = Fcar (tem);
+ struct Lisp_Cons *otem = XCONS (tem);
+#if 0 /* FSFmacs defun hack */
+ if (read_pure)
+ tem = Fpurecopy (Fcar (tem));
+ else
+#endif
+ tem = Fcar (tem);
*p = tem;
tem = otem->cdr;
free_cons (otem);
len = XINT (Flength (stuff));
if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
return
- continuable_read_syntax_error ("#[...] used with wrong number of elements");
+ continuable_syntax_error ("#[...] used with wrong number of elements");
for (iii = 0; CONSP (stuff); iii++)
{
- Lisp_Cons *victim = XCONS (stuff);
+ struct Lisp_Cons *victim = XCONS (stuff);
make_byte_code_args[iii] = Fcar (stuff);
if ((purify_flag || load_force_doc_strings)
&& CONSP (make_byte_code_args[iii])
Vvalues = Qnil;
load_in_progress = 0;
-
+
Vload_descriptor_list = Qnil;
/* kludge: locate-file does not work for a null load-path, even if
defsymbol (&Qcurrent_load_list, "current-load-list");
defsymbol (&Qload, "load");
defsymbol (&Qload_file_name, "load-file-name");
+ defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table");
defsymbol (&Qfset, "fset");
#ifdef LISP_BACKQUOTES
defsymbol (&Qcomma_at, ",@");
defsymbol (&Qcomma_dot, ",.");
#endif
-
- defsymbol (&Qexists, "exists");
- defsymbol (&Qreadable, "readable");
- defsymbol (&Qwritable, "writable");
- defsymbol (&Qexecutable, "executable");
}
void
}
void
-reinit_vars_of_lread (void)
-{
- Vread_buffer_stream = Qnil;
- staticpro_nodump (&Vread_buffer_stream);
-}
-
-void
vars_of_lread (void)
{
- reinit_vars_of_lread ();
-
DEFVAR_LISP ("values", &Vvalues /*
List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological.
*/ );
load_force_doc_strings = 0;
+ DEFVAR_LISP ("source-directory", &Vsource_directory /*
+Directory in which XEmacs sources were found when XEmacs was built.
+You cannot count on them to still be there!
+*/ );
+ Vsource_directory = Qnil;
+
/* See read_escape(). */
#if 0
/* Used to be named `puke-on-fsf-keys' */
with values saved when the image is dumped. */
staticpro (&Vload_descriptor_list);
+ Vread_buffer_stream = Qnil;
+ staticpro (&Vread_buffer_stream);
+
/* Initialized in init_lread. */
staticpro (&Vload_force_doc_string_list);
Vfile_domain = Qnil;
#endif
- Vread_objects = Qnil;
- staticpro (&Vread_objects);
-
- Vlocate_file_hash_table = make_lisp_hash_table (200,
- HASH_TABLE_NON_WEAK,
- HASH_TABLE_EQUAL);
- staticpro (&Vlocate_file_hash_table);
-#ifdef DEBUG_XEMACS
- symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
- = Vlocate_file_hash_table;
-#endif
+ read_objects = Qnil;
+ staticpro (&read_objects);
}
projects / chise / xemacs-chise.git.1 / blobdiff