(put_char): New function.
[bpt/emacs.git] / lib-src / make-docfile.c
index d8e9377..8a74de4 100644 (file)
@@ -1,5 +1,6 @@
 /* Generate doc-string file for GNU Emacs from source files.
-   Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86, 92, 93, 94, 97, 1999, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -15,7 +16,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
 
 /* The arguments given to this program are all the C and Lisp source files
  of GNU Emacs.  .elc and .el and .c files are allowed.
@@ -31,19 +33,115 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  Then comes the documentation for that function or variable.
  */
 
-#include <stdio.h>
+#define NO_SHORTNAMES   /* Tell config not to load remap.h */
+#include <config.h>
+
+/* defined to be emacs_main, sys_fopen, etc. in config.h */
+#undef main
+#undef fopen
+#undef chdir
 
+#include <stdio.h>
+#ifdef MSDOS
+#include <fcntl.h>
+#endif /* MSDOS */
+#ifdef WINDOWSNT
+#include <stdlib.h>
+#include <fcntl.h>
+#include <direct.h>
+#endif /* WINDOWSNT */
+
+#ifdef DOS_NT
+#define READ_TEXT "rt"
+#define READ_BINARY "rb"
+#else  /* not DOS_NT */
+#define READ_TEXT "r"
+#define READ_BINARY "r"
+#endif /* not DOS_NT */
+
+int scan_file ();
+int scan_lisp_file ();
+int scan_c_file ();
+
+#ifdef MSDOS
+/* s/msdos.h defines this as sys_chdir, but we're not linking with the
+   file where that function is defined.  */
+#undef chdir
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/* Stdio stream for output to the DOC file.  */
 FILE *outfile;
 
+/* Name this program was invoked with.  */
+char *progname;
+
+/* Print error message.  `s1' is printf control string, `s2' is arg for it. */
+
+/* VARARGS1 */
+void
+error (s1, s2)
+     char *s1, *s2;
+{
+  fprintf (stderr, "%s: ", progname);
+  fprintf (stderr, s1, s2);
+  fprintf (stderr, "\n");
+}
+
+/* Print error message and exit.  */
+
+/* VARARGS1 */
+void
+fatal (s1, s2)
+     char *s1, *s2;
+{
+  error (s1, s2);
+  exit (1);
+}
+
+/* Like malloc but get fatal error if memory is exhausted.  */
+
+long *
+xmalloc (size)
+     unsigned int size;
+{
+  long *result = (long *) malloc (size);
+  if (result == NULL)
+    fatal ("virtual memory exhausted", 0);
+  return result;
+}
+\f
+int
 main (argc, argv)
      int argc;
      char **argv;
 {
   int i;
   int err_count = 0;
+  int first_infile;
+
+  progname = argv[0];
 
   outfile = stdout;
 
+  /* Don't put CRs in the DOC file.  */
+#ifdef MSDOS
+  _fmode = O_BINARY;
+#if 0  /* Suspicion is that this causes hanging.
+         So instead we require people to use -o on MSDOS.  */
+  (stdout)->_flag &= ~_IOTEXT;
+  _setmode (fileno (stdout), O_BINARY);
+#endif
+  outfile = 0;
+#endif /* MSDOS */
+#ifdef WINDOWSNT
+  _fmode = O_BINARY;
+  _setmode (fileno (stdout), O_BINARY);
+#endif /* WINDOWSNT */
+
   /* If first two args are -o FILE, output to FILE.  */
   i = 1;
   if (argc > i + 1 && !strcmp (argv[i], "-o"))
@@ -56,54 +154,118 @@ main (argc, argv)
       outfile = fopen (argv[i + 1], "a");
       i += 2;
     }
+  if (argc > i + 1 && !strcmp (argv[i], "-d"))
+    {
+      chdir (argv[i + 1]);
+      i += 2;
+    }
+
+  if (outfile == 0)
+    fatal ("No output file specified", "");
 
+  first_infile = i;
   for (; i < argc; i++)
-    err_count += scan_file (argv[i]);  /* err_count seems to be {mis,un}used */
+    {
+      int j;
+      /* Don't process one file twice.  */
+      for (j = first_infile; j < i; j++)
+       if (! strcmp (argv[i], argv[j]))
+         break;
+      if (j == i)
+       err_count += scan_file (argv[i]);
+    }
 #ifndef VMS
-  exit (err_count);                    /* see below - shane */
-#endif VMS
+  exit (err_count > 0);
+#endif /* VMS */
+  return err_count > 0;
 }
 
 /* Read file FILENAME and output its doc strings to outfile.  */
 /* Return 1 if file is not found, 0 if it is found.  */
 
+int
 scan_file (filename)
      char *filename;
 {
   int len = strlen (filename);
-  if (!strcmp (filename + len - 4, ".elc"))
-    return scan_lisp_file (filename);
-  else if (!strcmp (filename + len - 3, ".el"))
-    return scan_lisp_file (filename);
+  if (len > 4 && !strcmp (filename + len - 4, ".elc"))
+    return scan_lisp_file (filename, READ_BINARY);
+  else if (len > 3 && !strcmp (filename + len - 3, ".el"))
+    return scan_lisp_file (filename, READ_TEXT);
   else
-    return scan_c_file (filename);
+    return scan_c_file (filename, READ_TEXT);
 }
 \f
 char buf[128];
 
-/* Skip a C string from INFILE,
- and return the character that follows the closing ".
- If printflag is positive, output string contents to outfile.
- If it is negative, store contents in buf.
- Convert escape sequences \n and \t to newline and tab;
- discard \ followed by newline.  */
+/* Add CH to either outfile, if PRINTFLAG is positive, or to the buffer
+   whose end is pointed to by BUFP, if PRINTFLAG is negative.
+   If the counters pointed to by PENDING_NEWLINES and PENDING_SPACES are
+   non-zero, that many newlines and spaces are output before CH, and
+   the counters are zeroed.  */
+
+static INLINE void
+put_char (ch, printflag, bufp, pending_newlines, pending_spaces)
+     int ch, printflag;
+     char **bufp;
+     unsigned *pending_newlines, *pending_spaces;
+{
+  int out_ch;
+  do
+    {
+      if (*pending_newlines > 0)
+       {
+         (*pending_newlines)--;
+         out_ch = '\n';
+       }
+      else if (*pending_spaces > 0)
+       {
+         (*pending_spaces)--;
+         out_ch = ' ';
+       }
+      else
+       out_ch = ch;
+
+      if (printflag > 0)
+       putc (out_ch, outfile);
+      else if (printflag < 0)
+       *(*bufp)++ = out_ch;
+    }
+  while (out_ch != ch);
+}
+
+/* Skip a C string or C-style comment from INFILE, and return the
+   character that follows.  COMMENT non-zero means skip a comment.  If
+   PRINTFLAG is positive, output string contents to outfile.  If it is
+   negative, store contents in buf.  Convert escape sequences \n and
+   \t to newline and tab; discard \ followed by newline.  */
 
-read_c_string (infile, printflag)
+int
+read_c_string_or_comment (infile, printflag, comment)
      FILE *infile;
      int printflag;
 {
   register int c;
+  unsigned pending_spaces = 0, pending_newlines = 0;
   char *p = buf;
 
-  c = getc (infile);
+  if (comment)
+    {
+      while ((c = getc (infile)) != EOF
+            && (c == '\n' || c == '\r' || c == '\t' || c == ' '))
+       ;
+    }
+  else
+    c = getc (infile);
+  
   while (c != EOF)
     {
-      while (c != '"' && c != EOF)
+      while (c != EOF && (comment ? c != '*' : c != '"'))
        {
          if (c == '\\')
            {
              c = getc (infile);
-             if (c == '\n')
+             if (c == '\n' || c == '\r')
                {
                  c = getc (infile);
                  continue;
@@ -113,68 +275,134 @@ read_c_string (infile, printflag)
              if (c == 't')
                c = '\t';
            }
-         if (printflag > 0)
-           putc (c, outfile);
-         else if (printflag < 0)
-           *p++ = c;
+         
+         if (c == ' ')
+           pending_spaces++;
+         else if (c == '\n')
+           {
+             pending_newlines++;
+             pending_spaces = 0;
+           }
+         else
+           put_char (c, printflag, &p, &pending_newlines, &pending_spaces);
+
          c = getc (infile);
        }
-      c = getc (infile);
-      if (c != '"')
-       break;
-      if (printflag > 0)
-       putc (c, outfile);
-      else if (printflag < 0)
-       *p++ = c;
-      c = getc (infile);
-    }
 
+      if (c != EOF)
+       c = getc (infile);
+
+      if (comment)
+       {
+         if (c == '/')
+           {
+             c = getc (infile);
+             break;
+           }
+         
+         put_char ('*', printflag, &p, &pending_newlines, &pending_spaces);
+       }
+      else
+       {
+         if (c != '"')
+           break;
+      
+         /* If we had a "", concatenate the two strings.  */
+         c = getc (infile);
+       }
+    }
+  
   if (printflag < 0)
     *p = 0;
 
   return c;
 }
+
+
 \f
-/* Write to file OUT the argument names of the function whose text is in BUF.
+/* Write to file OUT the argument names of function FUNC, whose text is in BUF.
    MINARGS and MAXARGS are the minimum and maximum number of arguments.  */
 
-write_c_args (out, buf, minargs, maxargs)
+void
+write_c_args (out, func, buf, minargs, maxargs)
      FILE *out;
-     char *buf;
+     char *func, *buf;
      int minargs, maxargs;
 {
-  register int c;
-  register char *p = buf;
-  int space = 0;
+  register char *p;
+  int in_ident = 0;
+  int just_spaced = 0;
+  int need_space = 1;
 
-  fprintf (out, "arguments: ");
+  fprintf (out, "(%s", func);
 
-  while (*p)
+  if (*buf == '(')
+    ++buf;
+
+  for (p = buf; *p; p++)
     {
-      c = *p++;
-      if (c == ',')
+      char c = *p;
+      int ident_start = 0;
+
+      /* Notice when we start printing a new identifier.  */
+      if ((('A' <= c && c <= 'Z')
+          || ('a' <= c && c <= 'z')
+          || ('0' <= c && c <= '9')
+          || c == '_')
+         != in_ident)
        {
-         minargs--;
-         maxargs--;
-         if (!space)
-           putc (' ', out);
-         if (minargs == 0 && maxargs > 0)
-           fprintf (out, "&optional ");
-         space = 1;
-         continue;
+         if (!in_ident)
+           {
+             in_ident = 1;
+             ident_start = 1;
+
+             if (need_space)
+               putc (' ', out);
+
+             if (minargs == 0 && maxargs > 0)
+               fprintf (out, "&optional ");
+             just_spaced = 1;
+
+             minargs--;
+             maxargs--;
+           }
+         else
+           in_ident = 0;
        }
-      else if (c == ' ' && space)
-       continue;
-      space = (c == ' ');
 
-      /* Print the C arguments as they would appear in Elisp;
-        print underscores as hyphens.  */
+      /* Print the C argument list as it would appear in lisp:
+        print underscores as hyphens, and print commas and newlines
+        as spaces.  Collapse adjacent spaces into one.  */
       if (c == '_')
-       putc ('-', out);
-      else
-       putc (c, out);
+       c = '-';
+      else if (c == ',' || c == '\n')
+       c = ' ';
+
+      /* In C code, `default' is a reserved word, so we spell it
+        `defalt'; unmangle that here.  */
+      if (ident_start
+         && strncmp (p, "defalt", 6) == 0
+         && ! (('A' <= p[6] && p[6] <= 'Z')
+               || ('a' <= p[6] && p[6] <= 'z')
+               || ('0' <= p[6] && p[6] <= '9')
+               || p[6] == '_'))
+       {
+         fprintf (out, "DEFAULT");
+         p += 5;
+         in_ident = 0;
+         just_spaced = 0;
+       }
+      else if (c != ' ' || !just_spaced)
+       {
+         if (c >= 'a' && c <= 'z')
+           /* Upcase the letter.  */
+           c += 'A' - 'a';
+         putc (c, out);
+       }
+
+      just_spaced = c == ' ';
+      need_space = 0;
     }
-  putc ('\n', out);
 }
 \f
 /* Read through a c file.  If a .o file is named,
@@ -182,20 +410,23 @@ write_c_args (out, buf, minargs, maxargs)
    Looks for DEFUN constructs such as are defined in ../src/lisp.h.
    Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED.  */
 
-scan_c_file (filename)
-     char *filename;
+int
+scan_c_file (filename, mode)
+     char *filename, *mode;
 {
   FILE *infile;
   register int c;
   register int commas;
   register int defunflag;
+  register int defvarperbufferflag;
   register int defvarflag;
   int minargs, maxargs;
+  int extension = filename[strlen (filename) - 1];
 
-  if (filename[strlen (filename) - 1] == 'o')
+  if (extension == 'o')
     filename[strlen (filename) - 1] = 'c';
 
-  infile = fopen (filename, "r");
+  infile = fopen (filename, mode);
 
   /* No error if non-ex input file */
   if (infile == NULL)
@@ -204,10 +435,15 @@ scan_c_file (filename)
       return 0;
     }
 
+  /* Reset extension to be able to detect duplicate files. */
+  filename[strlen (filename) - 1] = extension;
+
   c = '\n';
   while (!feof (infile))
     {
-      if (c != '\n')
+      int doc_keyword = 0;
+
+      if (c != '\n' && c != '\r')
        {
          c = getc (infile);
          continue;
@@ -228,8 +464,22 @@ scan_c_file (filename)
          c = getc (infile);
          if (c != 'V')
            continue;
+         c = getc (infile);
+         if (c != 'A')
+           continue;
+         c = getc (infile);
+         if (c != 'R')
+           continue;
+         c = getc (infile);
+         if (c != '_')
+           continue;
+
          defvarflag = 1;
          defunflag = 0;
+
+         c = getc (infile);
+         defvarperbufferflag = (c == 'P');
+
          c = getc (infile);
        }
       else if (c == 'D')
@@ -253,13 +503,20 @@ scan_c_file (filename)
          c = getc (infile);
        }
 
+      /* Lisp variable or function name.  */
       c = getc (infile);
       if (c != '"')
        continue;
-      c = read_c_string (infile, -1);
+      c = read_c_string_or_comment (infile, -1, 0);
+
+      /* DEFVAR_LISP ("name", addr, "doc")
+        DEFVAR_LISP ("name", addr /\* doc *\/)
+        DEFVAR_LISP ("name", addr, doc: /\* doc *\/)  */
 
       if (defunflag)
        commas = 5;
+      else if (defvarperbufferflag)
+       commas = 2;
       else if (defvarflag)
        commas = 1;
       else  /* For DEFSIMPLE and DEFPRED */
@@ -270,11 +527,12 @@ scan_c_file (filename)
          if (c == ',')
            {
              commas--;
+
              if (defunflag && (commas == 1 || commas == 2))
                {
                  do
                    c = getc (infile);
-                 while (c == ' ' || c == '\n' || c == '\t');
+                 while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
                  if (c < 0)
                    goto eof;
                  ungetc (c, infile);
@@ -287,40 +545,74 @@ scan_c_file (filename)
                      fscanf (infile, "%d", &maxargs);
                }
            }
-         if (c < 0)
+
+         if (c == EOF)
            goto eof;
          c = getc (infile);
        }
-      while (c == ' ' || c == '\n' || c == '\t')
+
+      while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
        c = getc (infile);
+      
       if (c == '"')
-       c = read_c_string (infile, 0);
-      while (c != ',')
-       c = getc (infile);
-      c = getc (infile);
-      while (c == ' ' || c == '\n' || c == '\t')
+       c = read_c_string_or_comment (infile, 0, 0);
+      
+      while (c != EOF && c != ',' && c != '/')
        c = getc (infile);
+      if (c == ',')
+       {
+         c = getc (infile);
+         while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
+           c = getc (infile);
+         while ((c >= 'a' && c <= 'z') || (c >= 'Z' && c <= 'Z'))
+           c = getc (infile);
+         if (c == ':')
+           {
+             doc_keyword = 1;
+             c = getc (infile);
+             while (c == ' ' || c == '\n' || c == '\r' || c == '\t')
+               c = getc (infile);
+           }
+       }
 
-      if (c == '"')
+      if (c == '"'
+         || (c == '/'
+             && (c = getc (infile),
+                 ungetc (c, infile),
+                 c == '*')))
        {
+         int comment = c != '"';
+         
          putc (037, outfile);
          putc (defvarflag ? 'V' : 'F', outfile);
          fprintf (outfile, "%s\n", buf);
-         c = read_c_string (infile, 1);
+
+         if (comment)
+           getc (infile);      /* Skip past `*' */
+         c = read_c_string_or_comment (infile, 1, comment);
 
          /* If this is a defun, find the arguments and print them.  If
             this function takes MANY or UNEVALLED args, then the C source
             won't give the names of the arguments, so we shouldn't bother
-            trying to find them.  */
+            trying to find them.
+
+            Various doc-string styles:
+             0: DEFUN (..., "DOC") (args)            [!comment]
+             1: DEFUN (..., /\* DOC *\/ (args))      [comment && !doc_keyword]
+             2: DEFUN (..., doc: /\* DOC *\/) (args) [comment && doc_keyword]
+         */
          if (defunflag && maxargs != -1)
            {
              char argbuf[1024], *p = argbuf;
-             while (c != ')')
-               {
-                 if (c < 0)
-                   goto eof;
-                 c = getc (infile);
-               }
+
+             if (!comment || doc_keyword)
+               while (c != ')')
+                 {
+                   if (c < 0)
+                     goto eof;
+                   c = getc (infile);
+                 }
+             
              /* Skip into arguments.  */
              while (c != '(')
                {
@@ -336,7 +628,7 @@ scan_c_file (filename)
              *p = '\0';
              /* Output them.  */
              fprintf (outfile, "\n\n");
-             write_c_args (outfile, argbuf, minargs, maxargs);
+             write_c_args (outfile, buf, argbuf, minargs, maxargs);
            }
        }
     }
@@ -348,37 +640,88 @@ 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 ...)
+  (defsubst 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 ...])
+  (defalias (quote NAME) #[... DOCSTRING ...])
+  (custom-declare-variable (quote NAME) VALUE 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.
+
+ We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
+ When we find that, we save it for the following defining-form,
+ and we use that instead of reading a doc string within that defining-form.
+
+ For defvar, defconst, and fset we skip to the docstring with a kludgy 
+ 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 newline immediately after the initial double-quote.  No newlines
+ must appear between the beginning of the form and the first double-quote.
+ For defun, defmacro, and autoload, we know how to skip over the
+ arglist, but the doc string must still have a backslash and newline
+ immediately after the double quote. 
+ The only source files that must follow this convention are preloaded
+ uncompiled ones like loaddefs.el and bindings.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 "
  */
 
-scan_lisp_file (filename)
-     char *filename;
+void
+skip_white (infile)
+     FILE *infile;
+{
+  char c = ' ';
+  while (c == ' ' || c == '\t' || c == '\n' || c == '\r')
+    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 == '\r' || 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);
+}
+
+int
+scan_lisp_file (filename, mode)
+     char *filename, *mode;
 {
   FILE *infile;
   register int c;
-  register int commas;
-  register char *p;
-  int defvarflag;
+  char *saved_string = 0;
 
-  infile = fopen (filename, "r");
+  infile = fopen (filename, mode);
   if (infile == NULL)
     {
       perror (filename);
@@ -388,392 +731,350 @@ scan_lisp_file (filename)
   c = '\n';
   while (!feof (infile))
     {
-      if (c != '\n')
+      char buffer[BUFSIZ];
+      char type;
+
+      /* If not at end of line, skip till we get to one.  */
+      if (c != '\n' && c != '\r')
        {
          c = getc (infile);
          continue;
        }
-      c = getc (infile);
+      /* Skip the line break.  */
+      while (c == '\n' || c == '\r')
+       c = getc (infile);
+      /* Detect a dynamic doc string and save it for the next expression.  */
+      if (c == '#')
+       {
+         c = getc (infile);
+         if (c == '@')
+           {
+             int length = 0;
+             int i;
+
+             /* Read the length.  */
+             while ((c = getc (infile),
+                     c >= '0' && c <= '9'))
+               {
+                 length *= 10;
+                 length += c - '0';
+               }
+
+             /* The next character is a space that is counted in the length
+                but not part of the doc string.
+                We already read it, so just ignore it.  */
+             length--;
+
+             /* Read in the contents.  */
+             if (saved_string != 0)
+               free (saved_string);
+             saved_string = (char *) malloc (length);
+             for (i = 0; i < length; i++)
+               saved_string[i] = getc (infile);
+             /* The last character is a ^_.
+                That is needed in the .elc file
+                but it is redundant in DOC.  So get rid of it here.  */
+             saved_string[length - 1] = 0;
+             /* Skip the line break.  */
+             while (c == '\n' && c == '\r')
+               c = getc (infile);
+             /* Skip the following line.  */
+             while (c != '\n' && c != '\r')
+               c = getc (infile);
+           }
+         continue;
+       }
+
       if (c != '(')
        continue;
 
-      /* Handle an autoload.  */
-      c = getc (infile);
-      if (c == 'a')
+      read_lisp_symbol (infile, buffer);
+
+      if (! strcmp (buffer, "defun")
+         || ! strcmp (buffer, "defmacro")
+         || ! strcmp (buffer, "defsubst"))
        {
-         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' && c != '\r'))
            {
-             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')
+         if (saved_string == 0)
            {
-             c = getc (infile);
-             if (c != 'n')
-               continue;
-             defvarflag = 0;
-           }
 
-         /* Or a defvar?  */
-         else if (c == 'v')
-           {
-             c = getc (infile);
-             if (c != 'a')
-               continue;
-             c = getc (infile);
-             if (c != 'r')
-               continue;
-             defvarflag = 1;
+             /* Skip until the end of line; remember two previous chars.  */
+             while (c != '\n' && c != '\r' && c >= 0)
+               {
+                 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 != '\\')
+               {
+#ifdef DEBUG
+                 fprintf (stderr, "## non-docstring in %s (%s)\n",
+                          buffer, filename);
+#endif
+                 continue;
+               }
            }
+       }
 
-         /* Or a defconst?  */
-         else if (c == 'c')
+      else if (! strcmp (buffer, "custom-declare-variable"))
+       {
+         char c1 = 0, c2 = 0;
+         type = 'V';
+
+         c = getc (infile);
+         if (c == '\'')
+           read_lisp_symbol (infile, buffer);
+         else
            {
+             if (c != '(')
+               {
+                 fprintf (stderr,
+                          "## unparsable name in custom-declare-variable in %s\n",
+                          filename);
+                 continue;
+               }
+             read_lisp_symbol (infile, buffer);
+             if (strcmp (buffer, "quote"))
+               {
+                 fprintf (stderr,
+                          "## unparsable name in custom-declare-variable 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 custom-declare-variable 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')
+         if (saved_string == 0)
            {
-             if (c == '\\')
-               c = getc (infile);
-             *p++ = c;
-             c = getc (infile);
+             /* Skip to end of line; remember the two previous chars.  */
+             while (c != '\n' && c != '\r' && c >= 0)
+               {
+                 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 != '\\')
+               {
+#ifdef DEBUG
+                 fprintf (stderr, "## non-docstring in %s (%s)\n",
+                          buffer, filename);
+#endif
+                 continue;
+               }
            }
-         *p = 0;
+       }
 
-         while (c == ' ' || c == '\n' || c == '\t')
-           c = getc (infile);
+      else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
+       {
+         char c1 = 0, c2 = 0;
+         type = 'F';
 
-         if (! defvarflag)
+         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 fset 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 fset in %s\n",
+                          filename);
+                 continue;
                }
+             read_lisp_symbol (infile, buffer);
              c = getc (infile);
+             if (c != ')')
+               {
+                 fprintf (stderr,
+                          "## unparsable quoted name in fset in %s\n",
+                          filename);
+                 continue;
+               }
            }
-         else
-           {
-             /* A variable:  */
-
-             /* Skip until the first newline; remember
-                the two previous characters.  */
-             char c1 = 0, c2 = 0;
 
-             while (c != '\n' && c >= 0)
+         if (saved_string == 0)
+           {
+             /* Skip to end of line; remember the two previous chars.  */
+             while (c != '\n' && c != '\r' && c >= 0)
                {
                  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 == '\\')
+             if (c2 != '"' || c1 != '\\')
                {
-                 putc (037, outfile);
-                 putc ('V', outfile);
-                 fprintf (outfile, "%s\n", buf);
-                 read_c_string (infile, 1);
+#ifdef DEBUG
+                 fprintf (stderr, "## non-docstring in %s (%s)\n",
+                          buffer, filename);
+#endif
+                 continue;
                }
-             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;
+      else if (! strcmp (buffer, "autoload"))
+       {
+         type = 'F';
          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')
+         if (c == '\'')
+           read_lisp_symbol (infile, buffer);
+         else
            {
-             if (c == '\\')
-               c = getc (infile);
-             *p++ = c;
+             if (c != '(')
+               {
+                 fprintf (stderr, "## unparsable name in autoload in %s\n",
+                          filename);
+                 continue;
+               }
+             read_lisp_symbol (infile, buffer);
+             if (strcmp (buffer, "quote"))
+               {
+                 fprintf (stderr, "## unparsable name in autoload in %s\n",
+                          filename);
+                 continue;
+               }
+             read_lisp_symbol (infile, buffer);
              c = getc (infile);
+             if (c != ')')
+               {
+                 fprintf (stderr,
+                          "## unparsable quoted name in autoload in %s\n",
+                          filename);
+                 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;
+         skip_white (infile);
+         if ((c = getc (infile)) != '\"')
+           {
+             fprintf (stderr, "## autoload of %s unparsable (%s)\n",
+                      buffer, filename);
+             continue;
+           }
+         read_c_string_or_comment (infile, 0, 0);
+         skip_white (infile);
 
-               /* 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;
-         }
+         if (saved_string == 0)
+           {
+             /* 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' && c != '\r'))
+               {
+#ifdef DEBUG
+                 fprintf (stderr, "## non-docstring in %s (%s)\n",
+                          buffer, filename);
+#endif
+                 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.  */
+#ifdef DEBUG
+      else if (! strcmp (buffer, "if")
+              || ! strcmp (buffer, "byte-code"))
+       ;
+#endif
 
-      /* Skip whitespace */
+      else
+       {
+#ifdef DEBUG
+         fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
+                  buffer, filename);
+#endif
+         continue;
+       }
 
-      while (c == ' ' || c == '\n' || c == '\t')
-       c = getc (infile);
+      /* At this point, we should either use the previous
+        dynamic doc string in saved_string
+        or gobble a doc string from the input file.
 
-      /* " 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;
+        In the latter case, the opening quote (and leading
+        backslash-newline) have already been read.  */
 
       putc (037, outfile);
-      putc ('F', outfile);
-      fprintf (outfile, "%s\n", buf);
-      read_c_string (infile, 1);
+      putc (type, outfile);
+      fprintf (outfile, "%s\n", buffer);
+      if (saved_string)
+       {
+         fputs (saved_string, outfile);
+         /* Don't use one dynamic doc string twice.  */
+         free (saved_string);
+         saved_string = 0;
+       }
+      else
+       read_c_string_or_comment (infile, 1, 0);
     }
   fclose (infile);
   return 0;