/* 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 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
-#undef NULL
-#include "config.h"
+#include <ctype.h>
+#include <config.h>
#include "lisp.h"
#ifndef standalone
#include "buffer.h"
#include "paths.h"
#include "commands.h"
+#include "keyboard.h"
+#include "termhooks.h"
#endif
#ifdef lint
#endif
#ifdef LISP_FLOAT_TYPE
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#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, Qload;
+
+extern Lisp_Object Qevent_symbol_element_mask;
/* non-zero if inside `load' */
int load_in_progress;
/* Search path for files to be loaded. */
Lisp_Object Vload_path;
+/* This is the user-visible association list that maps features to
+ lists of defs in their load files. */
+Lisp_Object Vload_history;
+
+/* This is useud to build the load history. */
+Lisp_Object Vcurrent_load_list;
+
/* File for get_file_char to read from. Use by load */
static FILE *instream;
\f
/* get a character from the tty */
-DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0,
- "Read a character from the command input (keyboard or macro).\n\
-It is returned as a number.")
- ()
+extern Lisp_Object read_char ();
+
+/* Read input events until we get one that's acceptable for our purposes.
+
+ If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
+ until we get a character we like, and then stuffed into
+ unread_switch_frame.
+
+ If ASCII_REQUIRED is non-zero, we check function key events to see
+ if the unmodified version of the symbol has a Qascii_character
+ property, and use that character, if present.
+
+ If ERROR_NONASCII is non-zero, we signal an error if the input we
+ get isn't an ASCII character with modifiers. If it's zero but
+ ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
+ character. */
+Lisp_Object
+read_filtered_event (no_switch_frame, ascii_required, error_nonascii)
+ int no_switch_frame, ascii_required, error_nonascii;
{
+#ifdef standalone
+ return make_number (getchar ());
+#else
register Lisp_Object val;
+ register Lisp_Object delayed_switch_frame = Qnil;
-#ifndef standalone
- val = read_char (0);
- if (XTYPE (val) != Lisp_Int)
+ /* Read until we get an acceptable event. */
+ retry:
+ val = read_char (0, 0, 0, Qnil, 0);
+
+ /* 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,
+ for example. Eventually, some code which can deal with
+ switch-frame events will read it and process it. */
+ if (no_switch_frame
+ && EVENT_HAS_PARAMETERS (val)
+ && EQ (EVENT_HEAD (val), Qswitch_frame))
{
- unread_command_char = val;
- error ("Object read was not a character");
+ delayed_switch_frame = val;
+ goto retry;
}
-#else
- val = getchar ();
-#endif
+
+ if (ascii_required)
+ {
+ /* Convert certain symbols to their ASCII equivalents. */
+ if (XTYPE (val) == Lisp_Symbol)
+ {
+ Lisp_Object tem, tem1, tem2;
+ tem = Fget (val, Qevent_symbol_element_mask);
+ if (!NILP (tem))
+ {
+ tem1 = Fget (Fcar (tem), Qascii_character);
+ /* Merge this symbol's modifier bits
+ with the ASCII equivalent of its basic code. */
+ if (!NILP (tem1))
+ XFASTINT (val) = XINT (tem1) | XINT (Fcar (Fcdr (tem)));
+ }
+ }
+
+ /* If we don't have a character now, deal with it appropriately. */
+ if (XTYPE (val) != Lisp_Int)
+ {
+ if (error_nonascii)
+ {
+ unread_command_events = Fcons (val, Qnil);
+ error ("Non-character input-event");
+ }
+ else
+ goto retry;
+ }
+ }
+
+ if (! NILP (delayed_switch_frame))
+ unread_switch_frame = delayed_switch_frame;
return val;
+#endif
+}
+
+DEFUN ("read-char", Fread_char, Sread_char, 0, 0, 0,
+ "Read a character from the command input (keyboard or macro).\n\
+It is returned as a number.\n\
+If the user generates an event which is not a character (i.e. a mouse\n\
+click or function key event), `read-char' signals an error. As an\n\
+exception, switch-frame events are put off until non-ASCII events can\n\
+be read.\n\
+If you want to read non-character events, or ignore them, call\n\
+`read-event' or `read-char-exclusive' instead.")
+ ()
+{
+ return read_filtered_event (1, 1, 1);
}
-#ifdef HAVE_X_WINDOWS
DEFUN ("read-event", Fread_event, Sread_event, 0, 0, 0,
"Read an event object from the input stream.")
()
{
- register Lisp_Object val;
-
- val = read_char (0);
- return val;
+ return read_filtered_event (0, 0, 0);
}
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 0, 0,
It is returned as a number. Non character events are ignored.")
()
{
- register Lisp_Object val;
-
-#ifndef standalone
- val = read_char (0);
- while (XTYPE (val) != Lisp_Int)
- val = read_char (0);
-#else
- val = getchar ();
-#endif
-
- return val;
+ return read_filtered_event (1, 1, 0);
}
-#endif /* HAVE_X_WINDOWS */
DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
"Don't use this yourself.")
Lisp_Object temp;
struct gcpro gcpro1;
Lisp_Object found;
+ /* 1 means inhibit the message at the beginning. */
+ int nomessage1 = 0;
+ Lisp_Object handler;
CHECK_STRING (str, 0);
str = Fsubstitute_in_file_name (str);
+ /* If file name is magic, call the handler. */
+ handler = Ffind_file_name_handler (str);
+ 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)
XSTRING (found)->data[XSTRING (found)->size - 1] = 0;
result = stat (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);
+ {
+ message ("Source file `%s' newer than byte-compiled file",
+ XSTRING (found)->data);
+ /* Don't immediately overwrite this message. */
+ if (!noninteractive)
+ nomessage1 = 1;
+ }
XSTRING (found)->data[XSTRING (found)->size - 1] = 'c';
}
error ("Failure to create stdio stream for %s", XSTRING (str)->data);
}
- if (NILP (nomessage))
+ if (NILP (nomessage) && !nomessage1)
message ("Loading %s...", XSTRING (str)->data);
GCPRO1 (str);
XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
record_unwind_protect (load_unwind, lispstream);
load_in_progress++;
- readevalloop (Qget_file_char, stream, Feval, 0);
+ readevalloop (Qget_file_char, stream, str, Feval, 0);
unbind_to (count, Qnil);
/* Run any load-hooks for this file. */
Lisp_Object stream;
{
fclose (*(FILE **) XSTRING (stream));
- free (XPNTR (stream));
+ xfree (XPNTR (stream));
if (--load_in_progress < 0) load_in_progress = 0;
return Qnil;
}
}
\f
+/* Merge the list we've accumulated of globals from the current input source
+ into the load_history variable. The details depend on whether
+ the source has an associated file name or not. */
+
+static void
+build_load_history (stream, source)
+ FILE *stream;
+ Lisp_Object source;
+{
+ register Lisp_Object tail, prev, newelt;
+ 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;
+ prev = Qnil;
+ foundit = 0;
+ while (!NILP (tail))
+ {
+ tem = Fcar (tail);
+
+ /* Find the feature's previous assoc list... */
+ if (!NILP (Fequal (source, Fcar (tem))))
+ {
+ foundit = 1;
+
+ /* If we're loading, remove it. */
+ if (loading)
+ {
+ if (NILP (prev))
+ Vload_history = Fcdr (tail);
+ else
+ Fsetcdr (prev, Fcdr (tail));
+ }
+
+ /* Otherwise, cons on new symbols that are not already members. */
+ else
+ {
+ tem2 = Vcurrent_load_list;
+
+ while (CONSP (tem2))
+ {
+ newelt = Fcar (tem2);
+
+ if (NILP (Fmemq (newelt, tem)))
+ Fsetcar (tail, Fcons (Fcar (tem),
+ Fcons (newelt, Fcdr (tem))));
+
+ tem2 = Fcdr (tem2);
+ QUIT;
+ }
+ }
+ }
+ else
+ prev = tail;
+ tail = Fcdr (tail);
+ 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);
+}
+
Lisp_Object
unreadpure () /* Used as unwind-protect function in readevalloop */
{
}
static void
-readevalloop (readcharfun, stream, evalfun, printflag)
+readevalloop (readcharfun, stream, sourcename, evalfun, printflag)
Lisp_Object readcharfun;
- FILE *stream;
+ FILE *stream;
+ Lisp_Object sourcename;
Lisp_Object (*evalfun) ();
int printflag;
{
register int c;
register Lisp_Object val;
int count = specpdl_ptr - specpdl;
+ struct gcpro gcpro1;
specbind (Qstandard_input, readcharfun);
+ specbind (Qcurrent_load_list, Qnil);
+
+ GCPRO1 (sourcename);
+
+ LOADHIST_ATTACH (sourcename);
while (1)
{
}
}
+ build_load_history (stream, sourcename);
+ UNGCPRO;
+
unbind_to (count, Qnil);
}
#ifndef standalone
+DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 2, "",
+ "Execute the current buffer as Lisp code.\n\
+Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
+BUFFER is the buffer to evaluate (nil means use current buffer).\n\
+PRINTFLAG controls printing of output:\n\
+nil means discard it; anything else is stream for print.\n\
+\n\
+If there is no error, point does not move. If there is an error,\n\
+point remains at the end of the last character read from the buffer.")
+ (bufname, printflag)
+ Lisp_Object bufname, printflag;
+{
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object tem, buf;
+
+ if (NILP (bufname))
+ buf = Fcurrent_buffer ();
+ else
+ buf = Fget_buffer (bufname);
+ if (NILP (buf))
+ error ("No such buffer.");
+
+ if (NILP (printflag))
+ tem = Qsymbolp;
+ else
+ tem = printflag;
+ specbind (Qstandard_output, tem);
+ record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+ readevalloop (buf, 0, XBUFFER (buf)->filename, Feval, !NILP (printflag));
+ unbind_to (count, Qnil);
+
+ return Qnil;
+}
+
+#if 0
DEFUN ("eval-current-buffer", Feval_current_buffer, Seval_current_buffer, 0, 1, "",
"Execute the current buffer as Lisp code.\n\
Programs can pass argument PRINTFLAG which controls printing of output:\n\
Lisp_Object printflag;
{
int count = specpdl_ptr - specpdl;
- Lisp_Object tem;
+ Lisp_Object tem, cbuf;
+
+ cbuf = Fcurrent_buffer ()
if (NILP (printflag))
tem = Qsymbolp;
specbind (Qstandard_output, tem);
record_unwind_protect (save_excursion_restore, save_excursion_save ());
SET_PT (BEGV);
- readevalloop (Fcurrent_buffer (), 0, Feval, !NILP (printflag));
+ readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
return unbind_to (count, Qnil);
}
+#endif
DEFUN ("eval-region", Feval_region, Seval_region, 2, 3, "r",
"Execute the region as Lisp code.\n\
Lisp_Object b, e, printflag;
{
int count = specpdl_ptr - specpdl;
- Lisp_Object tem;
+ Lisp_Object tem, cbuf;
+
+ cbuf = Fcurrent_buffer ();
if (NILP (printflag))
tem = Qsymbolp;
/* This both uses b and checks its type. */
Fgoto_char (b);
Fnarrow_to_region (make_number (BEGV), e);
- readevalloop (Fcurrent_buffer (), 0, Feval, !NILP (printflag));
+ readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
return unbind_to (count, Qnil);
}
return '\007';
case 'b':
return '\b';
+ case 'd':
+ return 0177;
case 'e':
return 033;
case 'f':
c = READCHAR;
if (c == '\\')
c = read_escape (readcharfun);
- return c | 0200;
+ return c | meta_modifier;
+
+ case 'S':
+ c = READCHAR;
+ if (c != '-')
+ error ("Invalid escape character syntax");
+ c = READCHAR;
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ return c | shift_modifier;
+
+ case 'H':
+ c = READCHAR;
+ if (c != '-')
+ error ("Invalid escape character syntax");
+ c = READCHAR;
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ return c | hyper_modifier;
+
+ case 'A':
+ c = READCHAR;
+ if (c != '-')
+ error ("Invalid escape character syntax");
+ c = READCHAR;
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ return c | alt_modifier;
+
+ case 's':
+ c = READCHAR;
+ if (c != '-')
+ error ("Invalid escape character syntax");
+ c = READCHAR;
+ if (c == '\\')
+ c = read_escape (readcharfun);
+ return c | super_modifier;
case 'C':
c = READCHAR;
c = READCHAR;
if (c == '\\')
c = read_escape (readcharfun);
- if (c == '?')
- return 0177;
+ if ((c & 0177) == '?')
+ return 0177 | c;
+ /* ASCII control chars are made from letters (both cases),
+ as well as the non-letters within 0100...0137. */
+ else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
+ return (c & (037 | ~0177));
+ else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
+ return (c & (037 | ~0177));
else
- return (c & (0200 | 037));
+ return c | ctrl_modifier;
case '0':
case '1':
case ')':
case ']':
- case '.':
{
register Lisp_Object val;
XSET (val, Lisp_Internal, c);
{
/* Accept compiled functions at read-time so that we don't have to
build them using function calls. */
- Lisp_Object tmp = read_vector (readcharfun);
- return Fmake_byte_code (XVECTOR(tmp)->size, XVECTOR (tmp)->contents);
+ Lisp_Object tmp;
+ tmp = read_vector (readcharfun);
+ return Fmake_byte_code (XVECTOR (tmp)->size,
+ XVECTOR (tmp)->contents);
}
+#ifdef USE_TEXT_PROPERTIES
+ if (c == '(')
+ {
+ Lisp_Object tmp;
+ struct gcpro gcpro1;
+
+ /* Read the string itself. */
+ tmp = read1 (readcharfun);
+ if (XTYPE (tmp) != Lisp_String)
+ Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
+ GCPRO1 (tmp);
+ /* Read the intervals and their properties. */
+ while (1)
+ {
+ Lisp_Object beg, end, plist;
+
+ beg = read1 (readcharfun);
+ if (XTYPE (beg) == Lisp_Internal)
+ {
+ if (XINT (beg) == ')')
+ break;
+ Fsignal (Qinvalid_read_syntax, Fcons (make_string ("invalid string property list", 28), Qnil));
+ }
+ end = read1 (readcharfun);
+ if (XTYPE (end) == Lisp_Internal)
+ Fsignal (Qinvalid_read_syntax,
+ Fcons (make_string ("invalid string property list", 28), Qnil));
+
+ plist = read1 (readcharfun);
+ if (XTYPE (plist) == Lisp_Internal)
+ Fsignal (Qinvalid_read_syntax,
+ Fcons (make_string ("invalid string property list", 28), Qnil));
+ Fset_text_properties (beg, end, plist, tmp);
+ }
+ UNGCPRO;
+ return tmp;
+ }
+#endif
UNREAD (c);
- return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
+ Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
case ';':
while ((c = READCHAR) >= 0 && c != '\n');
if (c == '\\')
c = read_escape (readcharfun);
/* c is -1 if \ newline has just been seen */
- if (c < 0)
+ if (c == -1)
{
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;
}
return make_string (read_buffer, p - read_buffer);
}
+ case '.':
+ {
+#ifdef LISP_FLOAT_TYPE
+ /* If a period is followed by a number, then we should read it
+ as a floating point number. Otherwise, it denotes a dotted
+ pair. */
+ int next_char = READCHAR;
+ UNREAD (next_char);
+
+ if (! isdigit (next_char))
+#endif
+ {
+ register Lisp_Object val;
+ XSET (val, Lisp_Internal, c);
+ return val;
+ }
+
+ /* Otherwise, we fall through! Note that the atom-reading loop
+ below will now loop at least once, assuring that we will not
+ try to UNREAD two characters in a row. */
+ }
default:
if (c <= 040) goto retry;
{
while (c > 040 &&
!(c == '\"' || c == '\'' || c == ';' || c == '?'
|| c == '(' || c == ')'
-#ifndef LISP_FLOAT_TYPE /* we need to see <number><dot><number> */
+#ifndef LISP_FLOAT_TYPE
+ /* If we have floating-point support, then we need
+ to allow <digits><dot><digits>. */
|| c =='.'
#endif /* not LISP_FLOAT_TYPE */
|| c == '[' || c == ']' || c == '#'
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++;
+#endif
if (p1 == p)
- /* It is. */
+ /* It is an integer. */
{
+#ifdef LISP_FLOAT_TYPE
+ if (p1[-1] == '.')
+ p1[-1] = '\0';
+#endif
XSET (val, Lisp_Int, atoi (read_buffer));
return val;
}
\f
#ifdef LISP_FLOAT_TYPE
-#include <ctype.h>
#define LEAD_INT 1
#define DOT_CHAR 2
#define TRAIL_INT 4
}
return (*cp == 0
&& (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
+ || state == (DOT_CHAR|TRAIL_INT)
|| state == (LEAD_INT|E_CHAR|EXP_INT)
- || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
+ || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
+ || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
}
#endif /* LISP_FLOAT_TYPE */
\f
the current buffer. address is the address of the slot in the buffer that is current now. */
void
-defvar_per_buffer (namestring, address, doc)
+defvar_per_buffer (namestring, address, type, doc)
char *namestring;
Lisp_Object *address;
+ Lisp_Object type;
char *doc;
{
Lisp_Object sym;
XSET (XSYMBOL (sym)->value, Lisp_Buffer_Objfwd,
(Lisp_Object *) offset);
*(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym;
+ *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type;
if (*(int *)(offset + (char *)&buffer_local_flags) == 0)
/* Did a DEFVAR_PER_BUFFER without initializing the corresponding
slot of buffer_local_flags */
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 (Vinvocation_directory))
+ {
+ /* Add to the path the ../lisp dir of the Emacs executable,
+ if that dir exists. */
+ Lisp_Object tem, tem1;
+ tem = Fexpand_file_name (build_string ("../lisp"),
+ Vinvocation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1) && NILP (Fmember (tem, Vload_path)))
+ Vload_path = nconc2 (Vload_path, Fcons (tem, Qnil));
+ }
+ }
}
else
Vload_path = decode_env_path (0, normal);
defsubr (&Sintern);
defsubr (&Sintern_soft);
defsubr (&Sload);
- defsubr (&Seval_current_buffer);
+ defsubr (&Seval_buffer);
defsubr (&Seval_region);
defsubr (&Sread_char);
defsubr (&Sread_char_exclusive);
-#ifdef HAVE_X_WINDOWS
defsubr (&Sread_event);
-#endif /* HAVE_X_WINDOWS */
defsubr (&Sget_file_char);
defsubr (&Smapatoms);
"*List of directories to search for files to load.\n\
Each element is a string (directory name) or nil (try default directory).\n\
Initialized based on EMACSLOADPATH environment variable, if any,\n\
-otherwise to default specified in by file `paths.h' when Emacs was built.");
+otherwise to default specified by file `paths.h' when Emacs was built.");
DEFVAR_BOOL ("load-in-progress", &load_in_progress,
"Non-nil iff inside of `load'.");
but does prevent execution of the rest of the FORMS.");
Vafter_load_alist = Qnil;
+ DEFVAR_LISP ("load-history", &Vload_history,
+ "Alist mapping source file names to symbols and features.\n\
+Each alist element is a list that starts with a file name,\n\
+except for one element (optional) that starts with nil and describes\n\
+definitions evaluated from buffers not visiting files.\n\
+The remaining elements of each list are symbols defined as functions\n\
+or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
+ Vload_history = Qnil;
+
+ DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
+ "Used for internal purposes by `load'.");
+ Vcurrent_load_list = Qnil;
+
+ Qcurrent_load_list = intern ("current-load-list");
+ staticpro (&Qcurrent_load_list);
+
Qstandard_input = intern ("standard-input");
staticpro (&Qstandard_input);
Qget_file_char = intern ("get-file-char");
staticpro (&Qget_file_char);
+
+ Qascii_character = intern ("ascii-character");
+ staticpro (&Qascii_character);
+
+ Qload = intern ("load");
+ staticpro (&Qload);
}