/* Lisp parsing and input streams.
- Copyright (C) 1985, 1986, 1987, 1988, 1989,
- 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1989,
+ 1993, 1994 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/stat.h>
#include <sys/file.h>
#include <ctype.h>
-#undef NULL
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#ifndef standalone
#include "buffer.h"
-#include "paths.h"
+#include <paths.h>
#include "commands.h"
#include "keyboard.h"
#include "termhooks.h"
#ifdef STDC_HEADERS
#include <stdlib.h>
#endif
+
+#ifdef MSDOS
+#include "msdos.h"
+/* These are redefined (correctly, but differently) in values.h. */
+#undef INTBITS
+#undef LONGBITS
+#undef SHORTBITS
+#endif
+
#include <math.h>
#endif /* LISP_FLOAT_TYPE */
-Lisp_Object Qread_char, Qget_file_char, Qstandard_input;
+Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
-Lisp_Object Qascii_character;
+Lisp_Object Qascii_character, Qload;
extern Lisp_Object Qevent_symbol_element_mask;
/* This is useud to build the load history. */
Lisp_Object Vcurrent_load_list;
+/* List of descriptors now open for Fload. */
+static Lisp_Object load_descriptor_list;
+
/* File for get_file_char to read from. Use by load */
static FILE *instream;
Lisp_Object readcharfun;
int c;
{
- if (XTYPE (readcharfun) == Lisp_Buffer)
+ if (c == -1)
+ /* Don't back up the pointer if we're unreading the end-of-input mark,
+ since readchar didn't advance it when we read it. */
+ ;
+ else if (XTYPE (readcharfun) == Lisp_Buffer)
{
if (XBUFFER (readcharfun) == current_buffer)
SET_PT (point - 1);
#ifdef standalone
return make_number (getchar ());
#else
- register Lisp_Object val;
- register Lisp_Object delayed_switch_frame = Qnil;
+ register Lisp_Object val, delayed_switch_frame;
+
+ delayed_switch_frame = Qnil;
/* Read until we get an acceptable event. */
retry:
val = read_char (0, 0, 0, Qnil, 0);
+ if (XTYPE (val) == Lisp_Buffer)
+ goto retry;
+
/* switch-frame events are put off until after the next ASCII
character. This is better than signalling an error just because
the last characters were typed to a separate minibuffer frame,
{
if (error_nonascii)
{
- unread_command_events = Fcons (val, Qnil);
+ Vunread_command_events = Fcons (val, Qnil);
error ("Non-character input-event");
}
else
\f
static void readevalloop ();
static Lisp_Object load_unwind ();
+static Lisp_Object load_descriptor_unwind ();
DEFUN ("load", Fload, Sload, 1, 4, 0,
"Execute a file of Lisp code named FILE.\n\
Lisp_Object found;
/* 1 means inhibit the message at the beginning. */
int nomessage1 = 0;
+ Lisp_Object handler;
+#ifdef MSDOS
+ char *dosmode = "rt";
+#endif
CHECK_STRING (str, 0);
str = Fsubstitute_in_file_name (str);
+ /* If file name is magic, call the handler. */
+ handler = Ffind_file_name_handler (str, Qload);
+ if (!NILP (handler))
+ return call5 (handler, Qload, str, noerror, nomessage, nosuffix);
+
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file */
if (XSTRING (str)->size > 0)
{
+ GCPRO1 (str);
fd = openp (Vload_path, str, !NILP (nosuffix) ? "" : ".elc:.el:",
&found, 0);
+ UNGCPRO;
}
if (fd < 0)
struct stat s1, s2;
int result;
- stat (XSTRING (found)->data, &s1);
+#ifdef MSDOS
+ dosmode = "rb";
+#endif
+ stat ((char *)XSTRING (found)->data, &s1);
XSTRING (found)->data[XSTRING (found)->size - 1] = 0;
- result = stat (XSTRING (found)->data, &s2);
+ result = stat ((char *)XSTRING (found)->data, &s2);
if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
{
message ("Source file `%s' newer than byte-compiled file",
XSTRING (found)->data[XSTRING (found)->size - 1] = 'c';
}
+#ifdef MSDOS
+ close (fd);
+ stream = fopen ((char *) XSTRING (found)->data, dosmode);
+#else
stream = fdopen (fd, "r");
+#endif
if (stream == 0)
{
close (fd);
*ptr = stream;
XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
record_unwind_protect (load_unwind, lispstream);
+ record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
+ load_descriptor_list
+ = Fcons (make_number (fileno (stream)), load_descriptor_list);
load_in_progress++;
readevalloop (Qget_file_char, stream, str, Feval, 0);
unbind_to (count, Qnil);
return Qnil;
}
+static Lisp_Object
+load_descriptor_unwind (oldlist)
+ Lisp_Object oldlist;
+{
+ load_descriptor_list = oldlist;
+}
+
+/* Close all descriptors in use for Floads.
+ This is used when starting a subprocess. */
+
+void
+close_load_descs ()
+{
+ Lisp_Object tail;
+ for (tail = load_descriptor_list; !NILP (tail); tail = XCONS (tail)->cdr)
+ close (XFASTINT (XCONS (tail)->car));
+}
\f
static int
complete_filename_p (pathname)
#ifdef VMS
|| index (s, ':')
#endif /* VMS */
+#ifdef MSDOS /* MW, May 1993 */
+ || (s[0] != '\0' && s[1] == ':' && s[2] == '/')
+#endif
);
}
int want_size;
register Lisp_Object filename;
struct stat st;
+ struct gcpro gcpro1;
+ GCPRO1 (str);
if (storeptr)
*storeptr = Qnil;
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = build_string (fn);
- return fd;
+ RETURN_UNGCPRO (fd);
}
}
break;
nsuffix += lsuffix + 1;
}
- if (absolute) return -1;
+ if (absolute)
+ RETURN_UNGCPRO (-1);
}
- return -1;
+ RETURN_UNGCPRO (-1);
}
\f
register Lisp_Object tem, tem2;
register int foundit, loading;
+ /* Don't bother recording anything for preloaded files. */
+ if (!NILP (Vpurify_flag))
+ return;
+
loading = stream || !NARROWED;
tail = Vload_history;
QUIT;
}
- /* If we're loading, cons the new assoc onto the front of load-history,
- the most-recently-loaded position. Also do this if we didn't find
- an existing member for the current source. */
- if (loading || !foundit)
- Vload_history = Fcons (Fnreverse(Vcurrent_load_list),
- Vload_history);
+ /* If we're loading, cons the new assoc onto the front of load-history,
+ the most-recently-loaded position. Also do this if we didn't find
+ an existing member for the current source. */
+ if (loading || !foundit)
+ Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
+ Vload_history);
}
Lisp_Object
{
register int c;
register Lisp_Object val;
- Lisp_Object oldlist;
int count = specpdl_ptr - specpdl;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1;
+ struct buffer *b = 0;
+
+ if (BUFFERP (readcharfun))
+ b = XBUFFER (readcharfun);
+ else if (MARKERP (readcharfun))
+ b = XMARKER (readcharfun)->buffer;
specbind (Qstandard_input, readcharfun);
+ specbind (Qcurrent_load_list, Qnil);
- oldlist = Vcurrent_load_list;
- GCPRO2 (sourcename, oldlist);
+ GCPRO1 (sourcename);
- Vcurrent_load_list = Qnil;
LOADHIST_ATTACH (sourcename);
while (1)
{
+ if (b != 0 && NILP (b->name))
+ error ("Reading from killed buffer");
+
instream = stream;
c = READCHAR;
if (c == ';')
}
build_load_history (stream, sourcename);
-
- Vcurrent_load_list = oldlist;
UNGCPRO;
unbind_to (count, Qnil);
if (p == read_buffer)
cancel = 1;
}
- else if (c & CHAR_META)
- /* Move the meta bit to the right place for a string. */
- *p++ = (c & ~CHAR_META) | 0x80;
else
- *p++ = c;
+ {
+ /* Allow `\C- ' and `\C-?'. */
+ if (c == (CHAR_CTL | ' '))
+ c = 0;
+ else if (c == (CHAR_CTL | '?'))
+ c = 127;
+
+ if (c & CHAR_META)
+ /* Move the meta bit to the right place for a string. */
+ c = (c & ~CHAR_META) | 0x80;
+ if (c & ~0xff)
+ error ("Invalid modifier in string");
+ *p++ = c;
+ }
}
if (c < 0) return Fsignal (Qend_of_file, Qnil);
if (c <= 040) goto retry;
{
register char *p = read_buffer;
+ int quoted = 0;
{
register char *end = read_buffer + read_buffer_size;
end = read_buffer + read_buffer_size;
}
if (c == '\\')
- c = READCHAR;
+ {
+ c = READCHAR;
+ quoted = 1;
+ }
*p++ = c;
c = READCHAR;
}
UNREAD (c);
}
- /* Is it an integer? */
- {
- register char *p1;
- register Lisp_Object val;
- p1 = read_buffer;
- if (*p1 == '+' || *p1 == '-') p1++;
- if (p1 != p)
- {
- while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
+ if (!quoted)
+ {
+ register char *p1;
+ register Lisp_Object val;
+ p1 = read_buffer;
+ if (*p1 == '+' || *p1 == '-') p1++;
+ /* Is it an integer? */
+ if (p1 != p)
+ {
+ while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
#ifdef LISP_FLOAT_TYPE
- /* Integers can have trailing decimal points. */
- if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
+ /* Integers can have trailing decimal points. */
+ if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
#endif
- if (p1 == p)
- /* It is an integer. */
- {
+ if (p1 == p)
+ /* It is an integer. */
+ {
#ifdef LISP_FLOAT_TYPE
- if (p1[-1] == '.')
- p1[-1] = '\0';
+ if (p1[-1] == '.')
+ p1[-1] = '\0';
#endif
- XSET (val, Lisp_Int, atoi (read_buffer));
- return val;
- }
- }
+ XSET (val, Lisp_Int, atoi (read_buffer));
+ return val;
+ }
+ }
#ifdef LISP_FLOAT_TYPE
- if (isfloat_string (read_buffer))
- return make_float (atof (read_buffer));
+ if (isfloat_string (read_buffer))
+ return make_float (atof (read_buffer));
#endif
- }
+ }
return intern (read_buffer);
}
{
Lisp_Object tem;
int len = strlen (str);
- Lisp_Object obarray = Vobarray;
+ Lisp_Object obarray;
+ obarray = Vobarray;
if (XTYPE (obarray) != Lisp_Vector || XVECTOR (obarray)->size == 0)
obarray = check_obarray (obarray);
tem = oblookup (obarray, str, len);
register Lisp_Object tail;
Lisp_Object bucket, tem;
- if (XTYPE (obarray) != Lisp_Vector ||
- (obsize = XVECTOR (obarray)->size) == 0)
+ if (XTYPE (obarray) != Lisp_Vector
+ || (obsize = XVECTOR (obarray)->size) == 0)
{
obarray = check_obarray (obarray);
obsize = XVECTOR (obarray)->size;
return Qnil;
}
-#define OBARRAY_SIZE 509
+#define OBARRAY_SIZE 1511
void
init_obarray ()
}
#endif /* NOTDEF */
-/* New replacement for DefIntVar; it ignores the doc string argument
- on the assumption that make-docfile will handle that. */
/* Define an "integer variable"; a symbol whose value is forwarded
to a C variable of type int. Sample call: */
/* DEFVARINT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
void
-defvar_int (namestring, address, doc)
+defvar_int (namestring, address)
char *namestring;
int *address;
- char *doc;
{
Lisp_Object sym;
sym = intern (namestring);
NIL if address contains 0 */
void
-defvar_bool (namestring, address, doc)
+defvar_bool (namestring, address)
char *namestring;
int *address;
- char *doc;
{
Lisp_Object sym;
sym = intern (namestring);
/* Similar but define a variable whose value is the Lisp Object stored at address. */
void
-defvar_lisp (namestring, address, doc)
+defvar_lisp (namestring, address)
char *namestring;
Lisp_Object *address;
- char *doc;
{
Lisp_Object sym;
sym = intern (namestring);
since marking the same slot twice can cause trouble with strings. */
void
-defvar_lisp_nopro (namestring, address, doc)
+defvar_lisp_nopro (namestring, address)
char *namestring;
Lisp_Object *address;
- char *doc;
{
Lisp_Object sym;
sym = intern (namestring);
dump_path = decode_env_path (0, PATH_DUMPLOADSEARCH);
if (! NILP (Fequal (dump_path, Vload_path)))
- Vload_path = decode_env_path (0, normal);
+ {
+ Vload_path = decode_env_path (0, normal);
+ if (!NILP (Vinstallation_directory))
+ {
+ /* Add to the path the lisp subdir of the
+ installation dir, if it exists. */
+ Lisp_Object tem, tem1;
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
+ }
+ else
+ /* That dir doesn't exist, so add the build-time
+ Lisp dirs instead. */
+ Vload_path = nconc2 (Vload_path, dump_path);
+ }
+ }
}
else
Vload_path = decode_env_path (0, normal);
{
dirfile = Fdirectory_file_name (dirfile);
if (access (XSTRING (dirfile)->data, 0) < 0)
- printf ("Warning: lisp library (%s) does not exist.\n",
- XSTRING (Fcar (path_tail))->data);
+ fprintf (stderr,
+ "Warning: Lisp directory `%s' does not exist.\n",
+ XSTRING (Fcar (path_tail))->data);
}
}
}
Vvalues = Qnil;
load_in_progress = 0;
+
+ load_descriptor_list = Qnil;
}
void
or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
Vload_history = Qnil;
- staticpro (&Vcurrent_load_list);
+ DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
+ "Used for internal purposes by `load'.");
Vcurrent_load_list = Qnil;
+ load_descriptor_list = Qnil;
+ staticpro (&load_descriptor_list);
+
+ Qcurrent_load_list = intern ("current-load-list");
+ staticpro (&Qcurrent_load_list);
+
Qstandard_input = intern ("standard-input");
staticpro (&Qstandard_input);
Qascii_character = intern ("ascii-character");
staticpro (&Qascii_character);
+
+ Qload = intern ("load");
+ staticpro (&Qload);
}
HCoop / bpt / emacs.git / blobdiff