[bpt/emacs.git] / lib-src / make-docfile.c

/* Generate doc-string file for GNU Emacs from source files.
   Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
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 arguments given to this program are all the C and Lisp source files
 of GNU Emacs.  .elc and .el and .c files are allowed.
 A .o file can also be specified; the .c file it was made from is used.
 This helps the makefile pass the correct list of files.

 The results, which go to standard output or to a file
 specified with -a or -o (-a to append, -o to start from nothing),
 are entries containing function or variable names and their documentation.
 Each entry starts with a ^_ character.
 Then comes F for a function or V for a variable.
 Then comes the function or variable name, terminated with a newline.
 Then comes the documentation for that function or variable.
 */

#include <stdio.h>

FILE *outfile;

main (argc, argv)
     int argc;
     char **argv;
{
  int i;
  int err_count = 0;

  outfile = stdout;

  /* If first two args are -o FILE, output to FILE.  */
  i = 1;
  if (argc > i + 1 && !strcmp (argv[i], "-o"))
    {
      outfile = fopen (argv[i + 1], "w");
      i += 2;
    }
  if (argc > i + 1 && !strcmp (argv[i], "-a"))
    {
      outfile = fopen (argv[i + 1], "a");
      i += 2;
    }
  if (argc > i + 1 && !strcmp (argv[i], "-d"))
    {
      chdir (argv[i + 1]);
      i += 2;
    }

  for (; i < argc; i++)
    err_count += scan_file (argv[i]);	/* err_count seems to be {mis,un}used */
#ifndef VMS
  exit (err_count);			/* see below - shane */
#endif VMS
}

/* Read file FILENAME and output its doc strings to outfile.  */
/* Return 1 if file is not found, 0 if it is found.  */

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);
  else
    return scan_c_file (filename);
}
\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.  */

read_c_string (infile, printflag)
     FILE *infile;
     int printflag;
{
  register int c;
  char *p = buf;

  c = getc (infile);
  while (c != EOF)
    {
      while (c != '"' && c != EOF)
	{
	  if (c == '\\')
	    {
	      c = getc (infile);
	      if (c == '\n')
		{
		  c = getc (infile);
		  continue;
		}
	      if (c == 'n')
		c = '\n';
	      if (c == 't')
		c = '\t';
	    }
	  if (printflag > 0)
	    putc (c, outfile);
	  else if (printflag < 0)
	    *p++ = c;
	  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 (printflag < 0)
    *p = 0;

  return c;
}
\f
/* Write to file OUT the argument names of the function whose text is in BUF.
   MINARGS and MAXARGS are the minimum and maximum number of arguments.  */

write_c_args (out, buf, minargs, maxargs)
     FILE *out;
     char *buf;
     int minargs, maxargs;
{
  register char *p;
  int in_ident = 0;
  int just_spaced = 0;

  fprintf (out, "arguments: ");

  for (p = buf; *p; p++)
    {
      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)
	{
	  if (!in_ident)
	    {
	      in_ident = 1;
	      ident_start = 1;

	      if (minargs == 0 && maxargs > 0)
		fprintf (out, "&optional ");
	      just_spaced = 1;

	      minargs--;
	      maxargs--;
	    }
	  else
	    in_ident = 0;
	}

      /* Print the C argument list as it would appear in lisp:
	 print underscores as hyphens, and print commas as spaces.
	 Collapse adjacent spaces into one.  */
      if (c == '_') c = '-';
      if (c == ',') 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)
	putc (c, out);

      just_spaced = (c == ' ');
    }
}
\f
/* Read through a c file.  If a .o file is named,
   the corresponding .c file is read instead.
   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;
{
  FILE *infile;
  register int c;
  register int commas;
  register int defunflag;
  register int defvarperbufferflag;
  register int defvarflag;
  int minargs, maxargs;

  if (filename[strlen (filename) - 1] == 'o')
    filename[strlen (filename) - 1] = 'c';

  infile = fopen (filename, "r");

  /* No error if non-ex input file */
  if (infile == NULL)
    {
      perror (filename);
      return 0;
    }

  c = '\n';
  while (!feof (infile))
    {
      if (c != '\n')
	{
	  c = getc (infile);
	  continue;
	}
      c = getc (infile);
      if (c == ' ')
	{
	  while (c == ' ')
	    c = getc (infile);
	  if (c != 'D')
	    continue;
	  c = getc (infile);
	  if (c != 'E')
	    continue;
	  c = getc (infile);
	  if (c != 'F')
	    continue;
	  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')
	{
	  c = getc (infile);
	  if (c != 'E')
	    continue;
	  c = getc (infile);
	  if (c != 'F')
	    continue;
	  c = getc (infile);
	  defunflag = c == 'U';
	  defvarflag = 0;
	}
      else continue;

      while (c != '(')
	{
	  if (c < 0)
	    goto eof;
	  c = getc (infile);
	}

      c = getc (infile);
      if (c != '"')
	continue;
      c = read_c_string (infile, -1);

      if (defunflag)
	commas = 5;
      else if (defvarperbufferflag)
	commas = 2;
      else if (defvarflag)
	commas = 1;
      else  /* For DEFSIMPLE and DEFPRED */
	commas = 2;

      while (commas)
	{
	  if (c == ',')
	    {
	      commas--;
	      if (defunflag && (commas == 1 || commas == 2))
		{
		  do
		    c = getc (infile);
		  while (c == ' ' || c == '\n' || c == '\t');
		  if (c < 0)
		    goto eof;
		  ungetc (c, infile);
		  if (commas == 2) /* pick up minargs */
		    fscanf (infile, "%d", &minargs);
		  else /* pick up maxargs */
		    if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
		      maxargs = -1;
		    else
		      fscanf (infile, "%d", &maxargs);
		}
	    }
	  if (c < 0)
	    goto eof;
	  c = getc (infile);
	}
      while (c == ' ' || c == '\n' || 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 = getc (infile);

      if (c == '"')
	{
	  putc (037, outfile);
	  putc (defvarflag ? 'V' : 'F', outfile);
	  fprintf (outfile, "%s\n", buf);
	  c = read_c_string (infile, 1);

	  /* 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.  */
	  if (defunflag && maxargs != -1)
	    {
	      char argbuf[1024], *p = argbuf;
	      while (c != ')')
		{
		  if (c < 0)
		    goto eof;
		  c = getc (infile);
		}
	      /* Skip into arguments.  */
	      while (c != '(')
		{
		  if (c < 0)
		    goto eof;
		  c = getc (infile);
		}
	      /* Copy arguments into ARGBUF.  */
	      *p++ = c;
	      do
		*p++ = c = getc (infile);
	      while (c != ')');
	      *p = '\0';
	      /* Output them.  */
	      fprintf (outfile, "\n\n");
	      write_c_args (outfile, argbuf, minargs, maxargs);
	    }
	}
    }
 eof:
  fclose (infile);
  return 0;
}
\f
/* Read a file of Lisp code, compiled or interpreted.
 Looks for
  (defun NAME ARGS DOCSTRING ...)
  (defmacro NAME ARGS DOCSTRING ...)
  (autoload (quote NAME) FILE DOCSTRING ...)
  (defvar NAME VALUE DOCSTRING)
  (defconst NAME VALUE DOCSTRING)
  (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
  (fset (quote NAME) #[... DOCSTRING ...])
 starting in column zero.
 (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;

  infile = fopen (filename, "r");
  if (infile == NULL)
    {
      perror (filename);
      return 0;				/* No error */
    }

  c = '\n';
  while (!feof (infile))
    {
      char buffer [BUFSIZ];
      char *fillp = buffer;
      char type;

      if (c != '\n')
	{
	  c = getc (infile);
	  continue;
	}
      c = getc (infile);
      if (c != '(')
	continue;

      read_lisp_symbol (infile, buffer);

      if (! strcmp (buffer, "defun") ||
	  ! strcmp (buffer, "defmacro"))
	{
	  type = 'F';
	  read_lisp_symbol (infile, buffer);

	  /* Skip the arguments: either "nil" or a list in parens */

	  c = getc (infile);
	  if (c == 'n') /* nil */
	    {
	      if ((c = getc (infile)) != 'i' ||
		  (c = getc (infile)) != 'l')
		{
		  fprintf (stderr, "## unparsable arglist in %s (%s)\n",
			   buffer, filename);
		  continue;
		}
	    }
	  else if (c != '(')
	    {
	      fprintf (stderr, "## unparsable arglist in %s (%s)\n",
		       buffer, filename);
	      continue;
	    }
	  else
	    while (c != ')')
	      c = getc (infile);
	  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')
	    {
#ifdef DEBUG
	      fprintf (stderr, "## non-docstring in %s (%s)\n",
		       buffer, filename);
#endif
	      continue;
	    }
	}

      else if (! strcmp (buffer, "defvar") ||
	       ! strcmp (buffer, "defconst"))
	{
	  char c1 = 0, c2 = 0;
	  type = 'V';
	  read_lisp_symbol (infile, buffer);

	  /* Skip until the first newline; remember the two previous chars. */
	  while (c != '\n' && 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;
	    }
	}

      else if (! strcmp (buffer, "fset"))
	{
	  char c1 = 0, c2 = 0;
	  type = 'F';

	  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 != ')')
		{
		  fprintf (stderr,
			   "## unparsable quoted name in fset in %s\n",
			   filename);
		  continue;
		}
	    }

	  /* Skip until the first newline; remember the two previous chars. */
	  while (c != '\n' && 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;
	    }
	}

      else if (! strcmp (buffer, "autoload"))
	{
	  type = 'F';
	  c = getc (infile);
	  if (c == '\'')
	    read_lisp_symbol (infile, buffer);
	  else
	    {
	      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;
		}
	    }
	  skip_white (infile);
	  if ((c = getc (infile)) != '\"')
	    {
	      fprintf (stderr, "## autoload of %s unparsable (%s)\n",
		       buffer, filename);
	      continue;
	    }
	  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')
	    {
#ifdef DEBUG
	      fprintf (stderr, "## non-docstring in %s (%s)\n",
		       buffer, filename);
#endif
	      continue;
	    }
	}

#ifdef DEBUG
      else if (! strcmp (buffer, "if") ||
	       ! strcmp (buffer, "byte-code"))
	;
#endif

      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 (type, outfile);
      fprintf (outfile, "%s\n", buffer);
      read_c_string (infile, 1);
    }
  fclose (infile);
  return 0;
}
Commit	Line	Data
f2cc4248	1	/* Generate doc-string file for GNU Emacs from source files.
e065a56e	2	Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
f2cc4248 RS	3
	4	This file is part of GNU Emacs.
	5
93320c23 JA	6	GNU Emacs is free software; you can redistribute it and/or modify
93320c23 JA	7	it under the terms of the GNU General Public License as published by
e065a56e	8	the Free Software Foundation; either version 2, or (at your option)
93320c23 JA	9	any later version.
93320c23 JA	10
f2cc4248	11	GNU Emacs is distributed in the hope that it will be useful,
93320c23 JA	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
f2cc4248	15
93320c23 JA	16	You should have received a copy of the GNU General Public License
	17	along with GNU Emacs; see the file COPYING. If not, write to
	18	the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
f2cc4248 RS	19
	20	/* The arguments given to this program are all the C and Lisp source files
	21	of GNU Emacs. .elc and .el and .c files are allowed.
	22	A .o file can also be specified; the .c file it was made from is used.
	23	This helps the makefile pass the correct list of files.
	24
	25	The results, which go to standard output or to a file
	26	specified with -a or -o (-a to append, -o to start from nothing),
	27	are entries containing function or variable names and their documentation.
	28	Each entry starts with a ^_ character.
	29	Then comes F for a function or V for a variable.
	30	Then comes the function or variable name, terminated with a newline.
	31	Then comes the documentation for that function or variable.
	32	*/
	33
	34	#include <stdio.h>
	35
	36	FILE *outfile;
	37
	38	main (argc, argv)
	39	int argc;
	40	char **argv;
	41	{
	42	int i;
	43	int err_count = 0;
	44
	45	outfile = stdout;
	46
	47	/* If first two args are -o FILE, output to FILE. */
	48	i = 1;
	49	if (argc > i + 1 && !strcmp (argv[i], "-o"))
	50	{
	51	outfile = fopen (argv[i + 1], "w");
	52	i += 2;
	53	}
	54	if (argc > i + 1 && !strcmp (argv[i], "-a"))
	55	{
	56	outfile = fopen (argv[i + 1], "a");
	57	i += 2;
	58	}
d2d92f7a JB	59	if (argc > i + 1 && !strcmp (argv[i], "-d"))
	60	{
	61	chdir (argv[i + 1]);
	62	i += 2;
	63	}
f2cc4248 RS	64
	65	for (; i < argc; i++)
	66	err_count += scan_file (argv[i]); /* err_count seems to be {mis,un}used */
	67	#ifndef VMS
	68	exit (err_count); /* see below - shane */
	69	#endif VMS
	70	}
	71
a8a7afbe	72	/* Read file FILENAME and output its doc strings to outfile. */
f2cc4248 RS	73	/* Return 1 if file is not found, 0 if it is found. */
	74
	75	scan_file (filename)
	76	char *filename;
	77	{
	78	int len = strlen (filename);
	79	if (!strcmp (filename + len - 4, ".elc"))
	80	return scan_lisp_file (filename);
	81	else if (!strcmp (filename + len - 3, ".el"))
	82	return scan_lisp_file (filename);
	83	else
	84	return scan_c_file (filename);
	85	}
	86	\f
	87	char buf[128];
	88
	89	/* Skip a C string from INFILE,
	90	and return the character that follows the closing ".
a8a7afbe	91	If printflag is positive, output string contents to outfile.
f2cc4248 RS	92	If it is negative, store contents in buf.
	93	Convert escape sequences \n and \t to newline and tab;
	94	discard \ followed by newline. */
	95
	96	read_c_string (infile, printflag)
	97	FILE *infile;
	98	int printflag;
	99	{
	100	register int c;
	101	char *p = buf;
	102
	103	c = getc (infile);
	104	while (c != EOF)
	105	{
	106	while (c != '"' && c != EOF)
	107	{
	108	if (c == '\\')
	109	{
	110	c = getc (infile);
	111	if (c == '\n')
	112	{
	113	c = getc (infile);
	114	continue;
	115	}
	116	if (c == 'n')
	117	c = '\n';
	118	if (c == 't')
	119	c = '\t';
	120	}
	121	if (printflag > 0)
	122	putc (c, outfile);
	123	else if (printflag < 0)
	124	*p++ = c;
	125	c = getc (infile);
	126	}
	127	c = getc (infile);
	128	if (c != '"')
	129	break;
	130	if (printflag > 0)
	131	putc (c, outfile);
	132	else if (printflag < 0)
	133	*p++ = c;
	134	c = getc (infile);
	135	}
	136
	137	if (printflag < 0)
	138	*p = 0;
	139
	140	return c;
	141	}
	142	\f
	143	/* Write to file OUT the argument names of the function whose text is in BUF.
	144	MINARGS and MAXARGS are the minimum and maximum number of arguments. */
	145
	146	write_c_args (out, buf, minargs, maxargs)
	147	FILE *out;
	148	char *buf;
	149	int minargs, maxargs;
	150	{
f125a9e8	151	register char *p;
30e4c427 JB	152	int in_ident = 0;
30e4c427 JB	153	int just_spaced = 0;
f2cc4248	154
772e2009	155	fprintf (out, "arguments: ");
f2cc4248	156
f125a9e8	157	for (p = buf; *p; p++)
f2cc4248	158	{
30e4c427	159	char c = *p;
3941a179	160	int ident_start = 0;
30e4c427 JB	161
	162	/* Notice when we start printing a new identifier. */
	163	if ((('A' <= c && c <= 'Z')
	164	\|\| ('a' <= c && c <= 'z')
	165	\|\| ('0' <= c && c <= '9')
	166	\|\| c == '_')
	167	!= in_ident)
f2cc4248	168	{
30e4c427 JB	169	if (!in_ident)
	170	{
	171	in_ident = 1;
3941a179	172	ident_start = 1;
f125a9e8	173
30e4c427 JB	174	if (minargs == 0 && maxargs > 0)
	175	fprintf (out, "&optional ");
	176	just_spaced = 1;
f125a9e8	177
30e4c427 JB	178	minargs--;
	179	maxargs--;
	180	}
	181	else
	182	in_ident = 0;
f2cc4248	183	}
30e4c427 JB	184
	185	/* Print the C argument list as it would appear in lisp:
	186	print underscores as hyphens, and print commas as spaces.
	187	Collapse adjacent spaces into one. */
	188	if (c == '_') c = '-';
	189	if (c == ',') c = ' ';
	190
3941a179 JB	191	/* In C code, `default' is a reserved word, so we spell it
	192	`defalt'; unmangle that here. */
	193	if (ident_start
	194	&& strncmp (p, "defalt", 6) == 0
	195	&& ! (('A' <= p[6] && p[6] <= 'Z')
	196	\|\| ('a' <= p[6] && p[6] <= 'z')
	197	\|\| ('0' <= p[6] && p[6] <= '9')
	198	\|\| p[6] == '_'))
	199	{
	200	fprintf (out, "default");
	201	p += 5;
	202	in_ident = 0;
	203	just_spaced = 0;
	204	}
	205	else if (c != ' ' \|\| ! just_spaced)
30e4c427 JB	206	putc (c, out);
	207
	208	just_spaced = (c == ' ');
f2cc4248	209	}
f2cc4248 RS	210	}
	211	\f
	212	/* Read through a c file. If a .o file is named,
	213	the corresponding .c file is read instead.
	214	Looks for DEFUN constructs such as are defined in ../src/lisp.h.
	215	Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */
	216
	217	scan_c_file (filename)
	218	char *filename;
	219	{
	220	FILE *infile;
	221	register int c;
	222	register int commas;
	223	register int defunflag;
84128dee	224	register int defvarperbufferflag;
f2cc4248 RS	225	register int defvarflag;
	226	int minargs, maxargs;
	227
	228	if (filename[strlen (filename) - 1] == 'o')
	229	filename[strlen (filename) - 1] = 'c';
	230
	231	infile = fopen (filename, "r");
	232
	233	/* No error if non-ex input file */
	234	if (infile == NULL)
	235	{
	236	perror (filename);
	237	return 0;
	238	}
	239
	240	c = '\n';
	241	while (!feof (infile))
	242	{
	243	if (c != '\n')
	244	{
	245	c = getc (infile);
	246	continue;
	247	}
	248	c = getc (infile);
	249	if (c == ' ')
	250	{
	251	while (c == ' ')
	252	c = getc (infile);
	253	if (c != 'D')
	254	continue;
	255	c = getc (infile);
	256	if (c != 'E')
	257	continue;
	258	c = getc (infile);
	259	if (c != 'F')
	260	continue;
	261	c = getc (infile);
	262	if (c != 'V')
	263	continue;
84128dee JB	264	c = getc (infile);
	265	if (c != 'A')
	266	continue;
	267	c = getc (infile);
	268	if (c != 'R')
	269	continue;
	270	c = getc (infile);
	271	if (c != '_')
	272	continue;
	273
f2cc4248 RS	274	defvarflag = 1;
f2cc4248 RS	275	defunflag = 0;
84128dee JB	276
	277	c = getc (infile);
	278	defvarperbufferflag = (c == 'P');
	279
f2cc4248 RS	280	c = getc (infile);
	281	}
	282	else if (c == 'D')
	283	{
	284	c = getc (infile);
	285	if (c != 'E')
	286	continue;
	287	c = getc (infile);
	288	if (c != 'F')
	289	continue;
	290	c = getc (infile);
	291	defunflag = c == 'U';
	292	defvarflag = 0;
	293	}
	294	else continue;
	295
	296	while (c != '(')
	297	{
	298	if (c < 0)
	299	goto eof;
	300	c = getc (infile);
	301	}
	302
	303	c = getc (infile);
	304	if (c != '"')
	305	continue;
	306	c = read_c_string (infile, -1);
	307
	308	if (defunflag)
	309	commas = 5;
84128dee JB	310	else if (defvarperbufferflag)
84128dee JB	311	commas = 2;
f2cc4248 RS	312	else if (defvarflag)
	313	commas = 1;
	314	else /* For DEFSIMPLE and DEFPRED */
	315	commas = 2;
	316
	317	while (commas)
	318	{
	319	if (c == ',')
	320	{
	321	commas--;
	322	if (defunflag && (commas == 1 \|\| commas == 2))
	323	{
	324	do
	325	c = getc (infile);
	326	while (c == ' ' \|\| c == '\n' \|\| c == '\t');
	327	if (c < 0)
	328	goto eof;
	329	ungetc (c, infile);
	330	if (commas == 2) /* pick up minargs */
	331	fscanf (infile, "%d", &minargs);
	332	else /* pick up maxargs */
	333	if (c == 'M' \|\| c == 'U') /* MANY \|\| UNEVALLED */
	334	maxargs = -1;
	335	else
	336	fscanf (infile, "%d", &maxargs);
	337	}
	338	}
	339	if (c < 0)
	340	goto eof;
	341	c = getc (infile);
	342	}
	343	while (c == ' ' \|\| c == '\n' \|\| c == '\t')
	344	c = getc (infile);
	345	if (c == '"')
	346	c = read_c_string (infile, 0);
	347	while (c != ',')
	348	c = getc (infile);
	349	c = getc (infile);
	350	while (c == ' ' \|\| c == '\n' \|\| c == '\t')
	351	c = getc (infile);
	352
	353	if (c == '"')
	354	{
	355	putc (037, outfile);
	356	putc (defvarflag ? 'V' : 'F', outfile);
	357	fprintf (outfile, "%s\n", buf);
772e2009 JB	358	c = read_c_string (infile, 1);
	359
	360	/* If this is a defun, find the arguments and print them. If
	361	this function takes MANY or UNEVALLED args, then the C source
	362	won't give the names of the arguments, so we shouldn't bother
	363	trying to find them. */
	364	if (defunflag && maxargs != -1)
f2cc4248 RS	365	{
	366	char argbuf[1024], *p = argbuf;
	367	while (c != ')')
	368	{
	369	if (c < 0)
	370	goto eof;
	371	c = getc (infile);
	372	}
	373	/* Skip into arguments. */
	374	while (c != '(')
	375	{
	376	if (c < 0)
	377	goto eof;
	378	c = getc (infile);
	379	}
	380	/* Copy arguments into ARGBUF. */
	381	*p++ = c;
	382	do
	383	*p++ = c = getc (infile);
	384	while (c != ')');
	385	*p = '\0';
	386	/* Output them. */
	387	fprintf (outfile, "\n\n");
	388	write_c_args (outfile, argbuf, minargs, maxargs);
	389	}
	390	}
	391	}
	392	eof:
	393	fclose (infile);
	394	return 0;
	395	}
	396	\f
	397	/* Read a file of Lisp code, compiled or interpreted.
	398	Looks for
	399	(defun NAME ARGS DOCSTRING ...)
23d6b5a6 JB	400	(defmacro NAME ARGS DOCSTRING ...)
23d6b5a6 JB	401	(autoload (quote NAME) FILE DOCSTRING ...)
f2cc4248 RS	402	(defvar NAME VALUE DOCSTRING)
f2cc4248 RS	403	(defconst NAME VALUE DOCSTRING)
23d6b5a6 JB	404	(fset (quote NAME) (make-byte-code ... DOCSTRING ...))
23d6b5a6 JB	405	(fset (quote NAME) #[... DOCSTRING ...])
f2cc4248	406	starting in column zero.
23d6b5a6 JB	407	(quote NAME) may appear as 'NAME as well.
	408	For defun, defmacro, and autoload, we know how to skip over the arglist.
	409	For defvar, defconst, and fset we skip to the docstring with a klugey
	410	formatting convention: all docstrings must appear on the same line as the
	411	initial open-paren (the one in column zero) and must contain a backslash
	412	and a double-quote immediately after the initial double-quote. No newlines
	413	must appear between the beginning of the form and the first double-quote.
	414	The only source file that must follow this convention is loaddefs.el; aside
	415	from that, it is always the .elc file that we look at, and they are no
	416	problem because byte-compiler output follows this convention.
f2cc4248 RS	417	The NAME and DOCSTRING are output.
	418	NAME is preceded by `F' for a function or `V' for a variable.
	419	An entry is output only if DOCSTRING has \ newline just after the opening "
	420	*/
	421
23d6b5a6 JB	422	void
	423	skip_white (infile)
	424	FILE *infile;
	425	{
	426	char c = ' ';
	427	while (c == ' ' \|\| c == '\t' \|\| c == '\n')
	428	c = getc (infile);
	429	ungetc (c, infile);
	430	}
	431
	432	void
	433	read_lisp_symbol (infile, buffer)
	434	FILE *infile;
	435	char *buffer;
	436	{
	437	char c;
	438	char *fillp = buffer;
	439
	440	skip_white (infile);
	441	while (1)
	442	{
	443	c = getc (infile);
	444	if (c == '\\')
	445	*(++fillp) = getc (infile);
	446	else if (c == ' ' \|\| c == '\t' \|\| c == '\n' \|\| c == '(' \|\| c == ')')
	447	{
	448	ungetc (c, infile);
	449	*fillp = 0;
	450	break;
	451	}
	452	else
	453	*fillp++ = c;
	454	}
	455
	456	if (! buffer[0])
	457	fprintf (stderr, "## expected a symbol, got '%c'\n", c);
	458
	459	skip_white (infile);
	460	}
	461
	462
f2cc4248 RS	463	scan_lisp_file (filename)
	464	char *filename;
	465	{
	466	FILE *infile;
	467	register int c;
f2cc4248 RS	468
	469	infile = fopen (filename, "r");
	470	if (infile == NULL)
	471	{
	472	perror (filename);
	473	return 0; /* No error */
	474	}
	475
	476	c = '\n';
	477	while (!feof (infile))
	478	{
23d6b5a6 JB	479	char buffer [BUFSIZ];
	480	char *fillp = buffer;
	481	char type;
	482
f2cc4248 RS	483	if (c != '\n')
	484	{
	485	c = getc (infile);
	486	continue;
	487	}
	488	c = getc (infile);
	489	if (c != '(')
	490	continue;
a8a7afbe	491
23d6b5a6 JB	492	read_lisp_symbol (infile, buffer);
	493
	494	if (! strcmp (buffer, "defun") \|\|
	495	! strcmp (buffer, "defmacro"))
f2cc4248	496	{
23d6b5a6 JB	497	type = 'F';
23d6b5a6 JB	498	read_lisp_symbol (infile, buffer);
f2cc4248	499
23d6b5a6	500	/* Skip the arguments: either "nil" or a list in parens */
f2cc4248	501
23d6b5a6 JB	502	c = getc (infile);
23d6b5a6 JB	503	if (c == 'n') /* nil */
f2cc4248	504	{
23d6b5a6 JB	505	if ((c = getc (infile)) != 'i' \|\|
	506	(c = getc (infile)) != 'l')
	507	{
	508	fprintf (stderr, "## unparsable arglist in %s (%s)\n",
	509	buffer, filename);
	510	continue;
	511	}
f2cc4248	512	}
23d6b5a6	513	else if (c != '(')
f2cc4248	514	{
23d6b5a6 JB	515	fprintf (stderr, "## unparsable arglist in %s (%s)\n",
	516	buffer, filename);
	517	continue;
f2cc4248	518	}
23d6b5a6 JB	519	else
23d6b5a6 JB	520	while (c != ')')
f2cc4248	521	c = getc (infile);
23d6b5a6 JB	522	skip_white (infile);
	523
	524	/* If the next three characters aren't `dquote bslash newline'
	525	then we're not reading a docstring.
	526	*/
	527	if ((c = getc (infile)) != '"' \|\|
	528	(c = getc (infile)) != '\\' \|\|
	529	(c = getc (infile)) != '\n')
f2cc4248	530	{
23d6b5a6 JB	531	#ifdef DEBUG
	532	fprintf (stderr, "## non-docstring in %s (%s)\n",
	533	buffer, filename);
	534	#endif
	535	continue;
f2cc4248	536	}
f2cc4248	537	}
a8a7afbe	538
23d6b5a6 JB	539	else if (! strcmp (buffer, "defvar") \|\|
23d6b5a6 JB	540	! strcmp (buffer, "defconst"))
f2cc4248	541	{
23d6b5a6 JB	542	char c1 = 0, c2 = 0;
	543	type = 'V';
	544	read_lisp_symbol (infile, buffer);
a8a7afbe	545
23d6b5a6 JB	546	/* Skip until the first newline; remember the two previous chars. */
23d6b5a6 JB	547	while (c != '\n' && c >= 0)
f2cc4248	548	{
23d6b5a6 JB	549	c2 = c1;
23d6b5a6 JB	550	c1 = c;
f2cc4248	551	c = getc (infile);
f2cc4248	552	}
23d6b5a6 JB	553
	554	/* If two previous characters were " and \,
	555	this is a doc string. Otherwise, there is none. */
	556	if (c2 != '"' \|\| c1 != '\\')
f2cc4248	557	{
23d6b5a6 JB	558	#ifdef DEBUG
	559	fprintf (stderr, "## non-docstring in %s (%s)\n",
	560	buffer, filename);
	561	#endif
	562	continue;
f2cc4248	563	}
23d6b5a6 JB	564	}
	565
	566	else if (! strcmp (buffer, "fset"))
	567	{
	568	char c1 = 0, c2 = 0;
	569	type = 'F';
a8a7afbe	570
23d6b5a6 JB	571	c = getc (infile);
	572	if (c == '\'')
	573	read_lisp_symbol (infile, buffer);
	574	else
f2cc4248	575	{
23d6b5a6 JB	576	if (c != '(')
	577	{
	578	fprintf (stderr, "## unparsable name in fset in %s\n",
	579	filename);
	580	continue;
	581	}
	582	read_lisp_symbol (infile, buffer);
	583	if (strcmp (buffer, "quote"))
	584	{
	585	fprintf (stderr, "## unparsable name in fset in %s\n",
	586	filename);
	587	continue;
	588	}
	589	read_lisp_symbol (infile, buffer);
f2cc4248	590	c = getc (infile);
23d6b5a6 JB	591	if (c != ')')
	592	{
	593	fprintf (stderr,
	594	"## unparsable quoted name in fset in %s\n",
	595	filename);
	596	continue;
	597	}
f2cc4248	598	}
f2cc4248	599
23d6b5a6 JB	600	/* Skip until the first newline; remember the two previous chars. */
23d6b5a6 JB	601	while (c != '\n' && c >= 0)
f2cc4248	602	{
23d6b5a6 JB	603	c2 = c1;
23d6b5a6 JB	604	c1 = c;
f2cc4248 RS	605	c = getc (infile);
f2cc4248 RS	606	}
23d6b5a6 JB	607
	608	/* If two previous characters were " and \,
	609	this is a doc string. Otherwise, there is none. */
	610	if (c2 != '"' \|\| c1 != '\\')
	611	{
	612	#ifdef DEBUG
	613	fprintf (stderr, "## non-docstring in %s (%s)\n",
	614	buffer, filename);
	615	#endif
	616	continue;
	617	}
	618	}
f2cc4248	619
23d6b5a6 JB	620	else if (! strcmp (buffer, "autoload"))
	621	{
	622	type = 'F';
	623	c = getc (infile);
	624	if (c == '\'')
	625	read_lisp_symbol (infile, buffer);
	626	else
f2cc4248	627	{
23d6b5a6	628	if (c != '(')
f2cc4248	629	{
23d6b5a6 JB	630	fprintf (stderr, "## unparsable name in autoload in %s\n",
	631	filename);
	632	continue;
f2cc4248	633	}
23d6b5a6 JB	634	read_lisp_symbol (infile, buffer);
23d6b5a6 JB	635	if (strcmp (buffer, "quote"))
f2cc4248	636	{
23d6b5a6 JB	637	fprintf (stderr, "## unparsable name in autoload in %s\n",
	638	filename);
	639	continue;
f2cc4248	640	}
23d6b5a6	641	read_lisp_symbol (infile, buffer);
f2cc4248	642	c = getc (infile);
23d6b5a6	643	if (c != ')')
f2cc4248	644	{
23d6b5a6 JB	645	fprintf (stderr,
	646	"## unparsable quoted name in autoload in %s\n",
	647	filename);
	648	continue;
f2cc4248	649	}
23d6b5a6 JB	650	}
	651	skip_white (infile);
	652	if ((c = getc (infile)) != '\"')
	653	{
	654	fprintf (stderr, "## autoload of %s unparsable (%s)\n",
	655	buffer, filename);
f2cc4248 RS	656	continue;
f2cc4248 RS	657	}
23d6b5a6 JB	658	read_c_string (infile, 0);
	659	skip_white (infile);
	660
	661	/* If the next three characters aren't `dquote bslash newline'
	662	then we're not reading a docstring.
	663	*/
	664	if ((c = getc (infile)) != '"' \|\|
	665	(c = getc (infile)) != '\\' \|\|
	666	(c = getc (infile)) != '\n')
a8a7afbe	667	{
23d6b5a6 JB	668	#ifdef DEBUG
	669	fprintf (stderr, "## non-docstring in %s (%s)\n",
	670	buffer, filename);
	671	#endif
	672	continue;
a8a7afbe	673	}
a8a7afbe	674	}
f2cc4248	675
23d6b5a6 JB	676	#ifdef DEBUG
	677	else if (! strcmp (buffer, "if") \|\|
	678	! strcmp (buffer, "byte-code"))
	679	;
	680	#endif
f2cc4248	681
23d6b5a6 JB	682	else
	683	{
	684	#ifdef DEBUG
	685	fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
	686	buffer, filename);
	687	#endif
	688	continue;
	689	}
f2cc4248	690
23d6b5a6 JB	691	/* At this point, there is a docstring that we should gobble.
	692	The opening quote (and leading backslash-newline) have already
	693	been read.
	694	*/
	695	putc ('\n', outfile);
f2cc4248	696	putc (037, outfile);
23d6b5a6 JB	697	putc (type, outfile);
23d6b5a6 JB	698	fprintf (outfile, "%s\n", buffer);
f2cc4248 RS	699	read_c_string (infile, 1);
	700	}
	701	fclose (infile);
	702	return 0;
	703	}