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

/* Generate doc-string file for GNU Emacs from source files.
   Copyright (C) 1985, 1986, 1992, 1993 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>
#ifdef MSDOS
#include <fcntl.h>
#endif /* MSDOS */

#ifdef MSDOS
#define READ_TEXT "rt"
#define READ_BINARY "rb"
#else /* not MSDOS */
#define READ_TEXT "r"
#define READ_BINARY "r"
#endif /* not MSDOS */

FILE *outfile;

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

#ifdef MSDOS
  _fmode = O_BINARY;	/* all of files are treated as binary files */
  (stdout)->_flag &= ~_IOTEXT;
  _setmode (fileno (stdout), O_BINARY);
#endif /* MSDOS */
  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, READ_BINARY);
  else if (!strcmp (filename + len - 3, ".el"))
    return scan_lisp_file (filename, READ_TEXT);
  else
    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.  */

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 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.
   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, mode)
     char *filename, *mode;
{
  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, mode);

  /* 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 ...])
  (defalias (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 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 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, mode)
     char *filename, *mode;
{
  FILE *infile;
  register int c;

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