aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib-src/make-docfile.c568
-rw-r--r--src/eval.c37
2 files changed, 230 insertions, 375 deletions
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index d8e9377f32..676f29cb9c 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -348,35 +348,74 @@ scan_c_file (filename)
/* Read a file of Lisp code, compiled or interpreted.
Looks for
(defun NAME ARGS DOCSTRING ...)
- (autoload 'NAME FILE DOCSTRING ...)
+ (defmacro NAME ARGS DOCSTRING ...)
+ (autoload (quote NAME) FILE DOCSTRING ...)
(defvar NAME VALUE DOCSTRING)
(defconst NAME VALUE DOCSTRING)
- (fset (quote NAME) (make-byte-code (quote ARGS) ... "\
- DOCSTRING")
+ (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
+ (fset (quote NAME) #[... DOCSTRING ...])
starting in column zero.
- ARGS, FILE or VALUE is ignored. We do not know how to parse Lisp code
- so we use a kludge to skip them:
- In a function definition, the form of ARGS of FILE is known, and we
- can skip it.
- In a variable definition, we use a formatting convention:
- the DOCSTRING, if present, must be followed by a closeparen and a newline,
- and no newline must appear between the defvar or defconst and the docstring,
- The only source file that must follow this convention is loaddefs.el;
- aside from that, it is always the .elc file that we look at, and
- they are no problem because byte-compiler output follows this convention.
+ (quote NAME) may appear as 'NAME as well.
+ For defun, defmacro, and autoload, we know how to skip over the arglist.
+ For defvar, defconst, and fset we skip to the docstring with a klugey
+ formatting convention: all docstrings must appear on the same line as the
+ initial open-paren (the one in column zero) and must contain a backslash
+ and a double-quote immediately after the initial double-quote. No newlines
+ must appear between the beginning of the form and the first double-quote.
+ The only source file that must follow this convention is loaddefs.el; aside
+ from that, it is always the .elc file that we look at, and they are no
+ problem because byte-compiler output follows this convention.
The NAME and DOCSTRING are output.
NAME is preceded by `F' for a function or `V' for a variable.
An entry is output only if DOCSTRING has \ newline just after the opening "
*/
+void
+skip_white (infile)
+ FILE *infile;
+{
+ char c = ' ';
+ while (c == ' ' || c == '\t' || c == '\n')
+ c = getc (infile);
+ ungetc (c, infile);
+}
+
+void
+read_lisp_symbol (infile, buffer)
+ FILE *infile;
+ char *buffer;
+{
+ char c;
+ char *fillp = buffer;
+
+ skip_white (infile);
+ while (1)
+ {
+ c = getc (infile);
+ if (c == '\\')
+ *(++fillp) = getc (infile);
+ else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')')
+ {
+ ungetc (c, infile);
+ *fillp = 0;
+ break;
+ }
+ else
+ *fillp++ = c;
+ }
+
+ if (! buffer[0])
+ fprintf (stderr, "## expected a symbol, got '%c'\n", c);
+
+ skip_white (infile);
+}
+
+
scan_lisp_file (filename)
char *filename;
{
FILE *infile;
register int c;
- register int commas;
- register char *p;
- int defvarflag;
infile = fopen (filename, "r");
if (infile == NULL)
@@ -388,6 +427,10 @@ scan_lisp_file (filename)
c = '\n';
while (!feof (infile))
{
+ char buffer [BUFSIZ];
+ char *fillp = buffer;
+ char type;
+
if (c != '\n')
{
c = getc (infile);
@@ -397,382 +440,213 @@ scan_lisp_file (filename)
if (c != '(')
continue;
- /* Handle an autoload. */
- c = getc (infile);
- if (c == 'a')
+ read_lisp_symbol (infile, buffer);
+
+ if (! strcmp (buffer, "defun") ||
+ ! strcmp (buffer, "defmacro"))
{
- c = getc (infile);
- if (c != 'u')
- continue;
- c = getc (infile);
- if (c != 't')
- continue;
- c = getc (infile);
- if (c != 'o')
- continue;
- c = getc (infile);
- if (c != 'l')
- continue;
- c = getc (infile);
- if (c != 'o')
- continue;
- c = getc (infile);
- if (c != 'a')
- continue;
- c = getc (infile);
- if (c != 'd')
- continue;
+ type = 'F';
+ read_lisp_symbol (infile, buffer);
- c = getc (infile);
- while (c == ' ')
- c = getc (infile);
+ /* Skip the arguments: either "nil" or a list in parens */
- if (c == '\'')
+ c = getc (infile);
+ if (c == 'n') /* nil */
{
- c = getc (infile);
+ if ((c = getc (infile)) != 'i' ||
+ (c = getc (infile)) != 'l')
+ {
+ fprintf (stderr, "## unparsable arglist in %s (%s)\n",
+ buffer, filename);
+ continue;
+ }
}
- else
+ else if (c != '(')
{
- if (c != '(')
- continue;
- c = getc (infile);
- if (c != 'q')
- continue;
- c = getc (infile);
- if (c != 'u')
- continue;
- c = getc (infile);
- if (c != 'o')
- continue;
- c = getc (infile);
- if (c != 't')
- continue;
- c = getc (infile);
- if (c != 'e')
- continue;
- c = getc (infile);
- if (c != ' ')
- continue;
- while (c == ' ')
- c = getc (infile);
+ fprintf (stderr, "## unparsable arglist in %s (%s)\n",
+ buffer, filename);
+ continue;
}
-
- p = buf;
- while (c != ' ' && c != ')')
- {
- if (c == EOF)
- return 1;
- if (c == '\\')
- c = getc (infile);
- *p++ = c;
+ else
+ while (c != ')')
c = getc (infile);
- }
- *p = 0;
-
- while (c != '"')
+ skip_white (infile);
+
+ /* If the next three characters aren't `dquote bslash newline'
+ then we're not reading a docstring.
+ */
+ if ((c = getc (infile)) != '"' ||
+ (c = getc (infile)) != '\\' ||
+ (c = getc (infile)) != '\n')
{
- if (c == EOF)
- return 1;
- c = getc (infile);
+#ifdef DEBUG
+ fprintf (stderr, "## non-docstring in %s (%s)\n",
+ buffer, filename);
+#endif
+ continue;
}
- c = read_c_string (infile, 0);
}
- /* Handle def* clauses. */
- else if (c == 'd')
+ else if (! strcmp (buffer, "defvar") ||
+ ! strcmp (buffer, "defconst"))
{
- c = getc (infile);
- if (c != 'e')
- continue;
- c = getc (infile);
- if (c != 'f')
- continue;
- c = getc (infile);
+ char c1 = 0, c2 = 0;
+ type = 'V';
+ read_lisp_symbol (infile, buffer);
- /* Is this a defun? */
- if (c == 'u')
+ /* Skip until the first newline; remember the two previous chars. */
+ while (c != '\n' && c >= 0)
{
+ c2 = c1;
+ c1 = c;
c = getc (infile);
- if (c != 'n')
- continue;
- defvarflag = 0;
}
-
- /* Or a defvar? */
- else if (c == 'v')
+
+ /* If two previous characters were " and \,
+ this is a doc string. Otherwise, there is none. */
+ if (c2 != '"' || c1 != '\\')
{
- c = getc (infile);
- if (c != 'a')
- continue;
- c = getc (infile);
- if (c != 'r')
- continue;
- defvarflag = 1;
+#ifdef DEBUG
+ fprintf (stderr, "## non-docstring in %s (%s)\n",
+ buffer, filename);
+#endif
+ continue;
}
+ }
+
+ else if (! strcmp (buffer, "fset"))
+ {
+ char c1 = 0, c2 = 0;
+ type = 'F';
- /* Or a defconst? */
- else if (c == 'c')
+ c = getc (infile);
+ if (c == '\'')
+ read_lisp_symbol (infile, buffer);
+ else
{
+ if (c != '(')
+ {
+ fprintf (stderr, "## unparsable name in fset in %s\n",
+ filename);
+ continue;
+ }
+ read_lisp_symbol (infile, buffer);
+ if (strcmp (buffer, "quote"))
+ {
+ fprintf (stderr, "## unparsable name in fset in %s\n",
+ filename);
+ continue;
+ }
+ read_lisp_symbol (infile, buffer);
c = getc (infile);
- if (c != 'o')
- continue;
- c = getc (infile);
- if (c != 'n')
- continue;
- c = getc (infile);
- if (c != 's')
- continue;
- c = getc (infile);
- if (c != 't')
- continue;
- defvarflag = 1;
+ if (c != ')')
+ {
+ fprintf (stderr,
+ "## unparsable quoted name in fset in %s\n",
+ filename);
+ continue;
+ }
}
- else
- continue;
-
- /* Now we have seen "defun" or "defvar" or "defconst". */
- while (c != ' ' && c != '\n' && c != '\t')
- c = getc (infile);
-
- while (c == ' ' || c == '\n' || c == '\t')
- c = getc (infile);
-
- /* Read and store name of function or variable being defined
- Discard backslashes that are for quoting. */
- p = buf;
- while (c != ' ' && c != '\n' && c != '\t')
+ /* Skip until the first newline; remember the two previous chars. */
+ while (c != '\n' && c >= 0)
{
- if (c == '\\')
- c = getc (infile);
- *p++ = c;
+ c2 = c1;
+ c1 = c;
c = getc (infile);
}
- *p = 0;
-
- while (c == ' ' || c == '\n' || c == '\t')
- c = getc (infile);
+
+ /* If two previous characters were " and \,
+ this is a doc string. Otherwise, there is none. */
+ if (c2 != '"' || c1 != '\\')
+ {
+#ifdef DEBUG
+ fprintf (stderr, "## non-docstring in %s (%s)\n",
+ buffer, filename);
+#endif
+ continue;
+ }
+ }
- if (! defvarflag)
+ else if (! strcmp (buffer, "autoload"))
+ {
+ type = 'F';
+ c = getc (infile);
+ if (c == '\'')
+ read_lisp_symbol (infile, buffer);
+ else
{
- /* A function: */
- /* Skip the arguments: either "nil" or a list in parens */
- if (c == 'n')
+ if (c != '(')
{
- while (c != ' ' && c != '\n' && c != '\t')
- c = getc (infile);
+ fprintf (stderr, "## unparsable name in autoload in %s\n",
+ filename);
+ continue;
}
- else
+ read_lisp_symbol (infile, buffer);
+ if (strcmp (buffer, "quote"))
{
- while (c != '(')
- c = getc (infile);
- while (c != ')')
- c = getc (infile);
+ fprintf (stderr, "## unparsable name in autoload in %s\n",
+ filename);
+ continue;
}
+ read_lisp_symbol (infile, buffer);
c = getc (infile);
- }
- else
- {
- /* A variable: */
-
- /* Skip until the first newline; remember
- the two previous characters. */
- char c1 = 0, c2 = 0;
-
- while (c != '\n' && c >= 0)
+ if (c != ')')
{
- c2 = c1;
- c1 = c;
- c = getc (infile);
- }
-
- /* If two previous characters were " and \,
- this is a doc string. Otherwise, there is none. */
- if (c2 == '"' && c1 == '\\')
- {
- putc (037, outfile);
- putc ('V', outfile);
- fprintf (outfile, "%s\n", buf);
- read_c_string (infile, 1);
+ fprintf (stderr,
+ "## unparsable quoted name in autoload in %s\n",
+ filename);
+ continue;
}
+ }
+ skip_white (infile);
+ if ((c = getc (infile)) != '\"')
+ {
+ fprintf (stderr, "## autoload of %s unparsable (%s)\n",
+ buffer, filename);
continue;
}
- }
-
- /* Handle an fset clause. */
- else if (c == 'f')
- {
- c = getc (infile);
- if (c != 's')
- continue;
- c = getc (infile);
- if (c != 'e')
- continue;
- c = getc (infile);
- if (c != 't')
- continue;
-
- /* Skip white space */
- do
- c = getc (infile);
- while (c == ' ' || c == '\n' || c == '\t');
-
- /* Recognize "(quote". */
- if (c != '(')
- continue;
- c = getc (infile);
- if (c != 'q')
- continue;
- c = getc (infile);
- if (c != 'u')
- continue;
- c = getc (infile);
- if (c != 'o')
- continue;
- c = getc (infile);
- if (c != 't')
- continue;
- c = getc (infile);
- if (c != 'e')
- continue;
-
- /* Skip white space */
- do
- c = getc (infile);
- while (c == ' ' || c == '\n' || c == '\t');
-
- /* Read and store name of function or variable being defined
- Discard backslashes that are for quoting. */
- p = buf;
- while (c != ')' && c != ' ' && c != '\n' && c != '\t')
+ read_c_string (infile, 0);
+ skip_white (infile);
+
+ /* If the next three characters aren't `dquote bslash newline'
+ then we're not reading a docstring.
+ */
+ if ((c = getc (infile)) != '"' ||
+ (c = getc (infile)) != '\\' ||
+ (c = getc (infile)) != '\n')
{
- if (c == '\\')
- c = getc (infile);
- *p++ = c;
- c = getc (infile);
+#ifdef DEBUG
+ fprintf (stderr, "## non-docstring in %s (%s)\n",
+ buffer, filename);
+#endif
+ continue;
}
- *p = '\0';
-
- /* Skip white space */
- do
- c = getc (infile);
- while (c == ' ' || c == '\n' || c == '\t');
-
- /* Recognize "(make-byte-code". */
- if (c != '(')
- continue;
- c = getc (infile);
- if (c != 'm')
- continue;
- c = getc (infile);
- if (c != 'a')
- continue;
- c = getc (infile);
- if (c != 'k')
- continue;
- c = getc (infile);
- if (c != 'e')
- continue;
- c = getc (infile);
- if (c != '-')
- continue;
- c = getc (infile);
- if (c != 'b')
- continue;
- c = getc (infile);
- if (c != 'y')
- continue;
- c = getc (infile);
- if (c != 't')
- continue;
- c = getc (infile);
- if (c != 'e')
- continue;
- c = getc (infile);
- if (c != '-')
- continue;
- c = getc (infile);
- if (c != 'c')
- continue;
- c = getc (infile);
- if (c != 'o')
- continue;
- c = getc (infile);
- if (c != 'd')
- continue;
- c = getc (infile);
- if (c != 'e')
- continue;
-
- /* Scan for a \" followed by a newline, or for )) followed by
- a newline. If we find the latter first, this function has
- no docstring. */
- {
- char c1 = 0, c2 = 0;
-
- for (;;)
- {
-
- /* Find newlines, and remember the two previous characters. */
- for (;;)
- {
- c = getc (infile);
-
- if (c == '\n' || c < 0)
- break;
-
- c2 = c1;
- c1 = c;
- }
-
- /* If we've hit eof, quit. */
- if (c == EOF)
- break;
-
- /* If the last two characters were \", this is a docstring. */
- else if (c2 == '"' && c1 == '\\')
- {
- putc (037, outfile);
- putc ('F', outfile);
- fprintf (outfile, "%s\n", buf);
- read_c_string (infile, 1);
- break;
- }
-
- /* If the last two characters were )), there is no
- docstring. */
- else if (c2 == ')' && c1 == ')')
- break;
- }
- continue;
- }
}
- else
- continue;
-
- /* Here for a function definition.
- We have skipped the file name or arguments
- and arrived at where the doc string is,
- if there is a doc string. */
-
- /* Skip whitespace */
- while (c == ' ' || c == '\n' || c == '\t')
- c = getc (infile);
+#ifdef DEBUG
+ else if (! strcmp (buffer, "if") ||
+ ! strcmp (buffer, "byte-code"))
+ ;
+#endif
- /* " followed by \ and newline means a doc string we should gobble */
- if (c != '"')
- continue;
- c = getc (infile);
- if (c != '\\')
- continue;
- c = getc (infile);
- if (c != '\n')
- continue;
+ else
+ {
+#ifdef DEBUG
+ fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
+ buffer, filename);
+#endif
+ continue;
+ }
+ /* At this point, there is a docstring that we should gobble.
+ The opening quote (and leading backslash-newline) have already
+ been read.
+ */
+ putc ('\n', outfile);
putc (037, outfile);
- putc ('F', outfile);
- fprintf (outfile, "%s\n", buf);
+ putc (type, outfile);
+ fprintf (outfile, "%s\n", buffer);
read_c_string (infile, 1);
}
fclose (infile);
diff --git a/src/eval.c b/src/eval.c
index 572410e961..4d4ca7c584 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -743,6 +743,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
register Lisp_Object form;
Lisp_Object env;
{
+ /* With cleanups from Hallvard Furuseth. */
register Lisp_Object expander, sym, def, tem;
while (1)
@@ -751,42 +752,23 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
in case it expands into another macro call. */
if (XTYPE (form) != Lisp_Cons)
break;
- sym = XCONS (form)->car;
- /* Detect ((macro lambda ...) ...) */
- if (XTYPE (sym) == Lisp_Cons
- && EQ (XCONS (sym)->car, Qmacro))
- {
- expander = XCONS (sym)->cdr;
- goto explicit;
- }
- if (XTYPE (sym) != Lisp_Symbol)
- break;
+ /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
+ def = sym = XCONS (form)->car;
+ tem = Qnil;
/* Trace symbols aliases to other symbols
until we get a symbol that is not an alias. */
- while (1)
+ while (XTYPE (def) == Lisp_Symbol)
{
QUIT;
+ sym = def;
tem = Fassq (sym, env);
if (NILP (tem))
{
def = XSYMBOL (sym)->function;
- if (XTYPE (def) == Lisp_Symbol && !EQ (def, Qunbound))
- sym = def;
- else
- break;
- }
- else
- {
-#if 0 /* This is turned off because it caused an element (foo . bar)
- to have the effect of defining foo as an alias for the macro bar.
- That is inconsistent; bar should be a function to expand foo. */
- if (XTYPE (tem) == Lisp_Cons
- && XTYPE (XCONS (tem)->cdr) == Lisp_Symbol)
- sym = XCONS (tem)->cdr;
- else
-#endif
- break;
+ if (!EQ (def, Qunbound))
+ continue;
}
+ break;
}
/* Right now TEM is the result from SYM in ENV,
and if TEM is nil then DEF is SYM's function definition. */
@@ -818,7 +800,6 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
if (NILP (expander))
break;
}
- explicit:
form = apply1 (expander, XCONS (form)->cdr);
}
return form;